Question

早上好我已修改此帖子中的代码：Automating Mail Merge using Excel VBA

但是我只想要pdf输出，但是一旦我拿出字代码，它就会被打包。我认为问题是，如果我不将其保存为单词，它不会正确关闭模板（有关闭它的代码）。我必须手动点击“不保存”然后它会在尝试重新打开下一行的文件时窒息。知道怎么解决这个问题吗？ - 任何帮助非常感谢。感谢。

Public Sub MailMergeCert()
Dim bCreatedWordInstance As Boolean
Dim objWord As Word.Application
Dim objMMMD As Word.Document

Dim FirstName As String
Dim LastName As String
Dim Training As String
Dim SeminarDate As String
Dim HoursComp As String
Dim Location As String
Dim Objectives As String
Dim Trainer As String


Dim r As Long
Dim ThisFileName As String

'Your Sheet names need to be correct in here
Set sh1 = Sheets("Periop")

lastrow = Sheets("Periop").Range("A" & Rows.Count).End(xlUp).Row
r = 2

For r = 2 To lastrow
If IsEmpty(Cells(r, 10).Value) = False Then GoTo nextrow

FirstName = sh1.Cells(r, 1).Value
LastName = sh1.Cells(r, 2).Value
Training = sh1.Cells(r, 3).Value
SeminarDate = sh1.Cells(r, 4).Value
HoursComp = sh1.Cells(r, 5).Value
Location = sh1.Cells(r, 6).Value
Objectives = sh1.Cells(r, 7).Value
Trainer = sh1.Cells(r, 8).Value

SeminarDate = Format(sh1.Cells(r, 4).Value, "d mmmm YYYY")


' Setup filenames
Const WTempName = "Certificate_Periop_2016.docx" 'Template name

' Setup directories
cDir = ActiveWorkbook.Path + "\" 'Change if required
ThisFileName = ThisWorkbook.Name

On Error Resume Next

' Create a Word Application instance
bCreatedWordInstance = False
Set objWord = GetObject(, "Word.Application")

If objWord Is Nothing Then
  Err.Clear
  Set objWord = CreateObject("Word.Application")
  bCreatedWordInstance = True
End If

If objWord Is Nothing Then
MsgBox "Could not start Word"
Err.Clear
On Error GoTo 0
Exit Sub
End If

' Let Word trap the errors
On Error GoTo 0

' Set to True if you want to see the Word Doc flash past during construction
objWord.Visible = False

'Open Word Template
Set objMMMD = objWord.Documents.Open(cDir + WTempName)
objMMMD.Activate

'Merge the data
With objMMMD
.MailMerge.OpenDataSource Name:=cDir + ThisFileName, sqlstatement:="SELECT *  FROM `Periop$`"   ' Set this as required

With objMMMD.MailMerge  'With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
  .FirstRecord = r - 1
  .LastRecord = r - 1
  .ActiveRecord = r - 1
  ' EmployeeName = .EmployeeName
End With
.Execute Pause:=False
End With
End With

' Save new file
'Path and YYMM
Dim PeriopCertPath As String
PeriopCertPath = "C:\Users\305015724\Documents\ApplicationsTraining\2016\Periop\"
Dim YYMM As String
YYMM = Format(sh1.Cells(r, 11).Value, "YYMM")

'Word document
Dim NewFileNameWd As String
NewFileNameWd = YYMM & "_" & sh1.Cells(r, 12).Value & "_" & sh1.Cells(r, 2).Value & ".docx" 'Change File Name as req'd"
objWord.ActiveDocument.SaveAs Filename:=PeriopCertPath & NewFileNameWd

'PDF
Dim NewFileNamePDF As String
NewFileNamePDF = YYMM & "_" & sh1.Cells(r, 12).Value & "_" & sh1.Cells(r, 2).Value '& ".pdf" 'Change File Name as req'd"
objWord.ActiveDocument.ExportAsFixedFormat PeriopCertPath & NewFileNamePDF, ExportFormat:=wdExportFormatPDF

' Close the Mail Merge Main Document
objMMMD.Close savechanges:=wdDoNotSaveChanges
Set objMMMD = Nothing

' Close the New Mail Merged Document
If bCreatedWordInstance Then
objWord.Quit
End If

0:
Set objWord = Nothing
Cells(r, 10).Value = Date
nextrow:

Next r
End Sub

Answer 1

我记录了将工作簿保存为pdf，这是输出：

ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    "C:\Users\me\Desktop\Doc1.pdf", ExportFormat:=wdExportFormatPDF, _
    OpenAfterExport:=True, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
    wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
    IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
    wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
    True, UseISO19005_1:=False

好像你可能会尝试：

objWord.ActiveDocument.ExportAsFixedFormat PeriopCertPath & NewFileNamePDF,
    ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False

Answer 2

pdf生成始终有效，我想我现在也对Word位进行了排序。这是生成pdf然后关闭Word（以及其他一些东西......）的代码的一部分。

'Print Certificate
'Print required
If sh1.Cells(r, 12) = "print" Then
    'remove background image
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.WholeStory
    Selection.Cut
    'Print Certificate
   objWord.ActiveDocument.PrintOut
    'Close the Mail Merge Main Document
    objWord.ActiveDocument.Close (wdDoNotSaveChanges)
    objMMMD.Close savechanges:=wdDoNotSaveChanges
    Set objMMMD = Nothing
Else
    'Close the Mail Merge Main Document
    objWord.ActiveDocument.Close (wdDoNotSaveChanges)
    objMMMD.Close savechanges:=wdDoNotSaveChanges
    Set objMMMD = Nothing
End If

' Create a Word Application instance
bCreatedWordInstance = False
Set objWord = GetObject(, "Word.Application")
' Close the New Mail Merged Document
If bCreatedWordInstance Then
    objWord.Quit
End If

0:
Set objWord = Nothing

VBA Mailmerge到pdf输出

2 个答案: