从Excel列表将邮件合并为PDF

Question

背景：有一个包含两列的Excel电子表格：名称和金额，还有一个使用这两列的Word Mail Merge模板。假设此宏可以循环遍历电子表格中的所有行，并为每行保存一个PDF。

尝试保存PDF时出现错误

  

“对象不支持此属性或方法”

在此行

objWord.ActiveDocument.ExportAsFixedFormat cDir + "\Letters\" + NewFileName, 17

我是新手，根据其他帖子将其拼凑在一起。感谢这个社区帮助我走了这么远，我感谢您为解决此错误提供的所有帮助。

Sub GenerateLetters()
Dim bCreatedWordInstance As Boolean
Dim PracticeName As String
Dim cDir As String
Dim r As Long
Dim ThisFileName As String
r = 2
lastrow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row


For r = 2 To lastrow
PracticeName = Sheets("Data").Cells(r, 1).Value

' Setup filenames
Const WTempName = "Letter.docx"
Dim NewFileName As String
NewFileName = PracticeName & ".pdf"

' Setup directories
cDir = ActiveWorkbook.Path + "\" 'Change if appropriate

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 `Data$`"   ' Set this as required

With objMMMD.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True

With .DataSource
  .FirstRecord = r - 1
  .LastRecord = r - 1
  .ActiveRecord = r - 1

End With
.Execute Pause:=False
End With
End With

' Save new file as PDF
objWord.ActiveDocument.ExportAsFixedFormat cDir + "\Letters\" + NewFileName, 17

' 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

Next r
End Sub