我已经创建了一个vba宏,把零碎的东西放在一起,代码运行,但没有交付它应该交付的东西。宏运行,它说它的完整,但实际上并没有给予我的邮件合并PDF或DOC文档
我到处都找过了,我试着穿过它。就好像它跳过了邮件合并部分。
Sub MailMergeToPDF()
Dim wdApp As Object ' Word.Application
Dim wdDoc As Object ' Word.Document
Dim SourcePath As String
Dim SavePath As String
Dim i As Long
' Set the file paths
SourcePath = "C:\Users\username\Documents\Notice Template.docx"
SavePath = "C:\Users\username\Documents\Notice Folder"
' Create a new instance of Word
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
End If
' Disable Word alerts to avoid prompts
wdApp.DisplayAlerts = False
' Loop through the Excel data and perform the mail merge
With ThisWorkbook.Sheets("MailMerge Sheet") ' Change "Sheet1" to the actual name of your Excel data sheet
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row ' Assuming data starts from row 2
' Open the Word document template
Set wdDoc = wdApp.Documents.Open(SourcePath)
' Replace tokens in the Word document with data from Excel
With wdDoc.Content.Find
.Text = "<<Today>>" ' Replace this with your token in the Word document
.Replacement.Text = .Cells(i, 1).Value ' Assuming the data for the first name is in column A
.Wrap = 1 ' wdFindContinue
.Execute Replace:=2 ' wdReplaceAll
End With
' Add other token replacements here following the same pattern as above
With wdDoc.Content.Find
.Text = "<<Employee_Name>>" ' Replace this with the token for last name in the Word document
.Replacement.Text = .Cells(i, 2).Value ' Assuming the data for the last name is in column B
.Wrap = 1 ' wdFindContinue
.Execute Replace:=2 ' wdReplaceAll
End With
' Add other token replacements here following the same pattern as above
With wdDoc.Content.Find
.Text = "<<Vacation_Used>>" ' Replace this with the token for last name in the Word document
.Replacement.Text = .Cells(i, 3).Value ' Assuming the data for the last name is in column B
.Wrap = 1 ' wdFindContinue
.Execute Replace:=2 ' wdReplaceAll
End With
' Save the merged document as PDF with a specific title based on Excel data
Dim PDFFileName As String
PDFFileName = "Name of Document " & .Cells(i, 2).Value ' Combine first name and last name to form the PDF title
wdDoc.ExportAsFixedFormat SavePath & PDFFileName & ".pdf", 17 ' 17 is wdExportFormatPDF
' Close the Word document
wdDoc.Close SaveChanges:=False
Next i
End With
' Quit Word
wdApp.Quit
' Clean up
Set wdDoc = Nothing
Set wdApp = Nothing
' Inform the user that the process is completed
MsgBox "Mail Merge and PDF creation completed successfully!", vbInformation
End Sub
字符串
2条答案
按热度按时间2cmtqfgy1#
在路径名中添加反斜杠
字符串
以获取有效的文件名。
由于
DisplayAlerts=False
,未看到错误消息xytpbqjk2#
如果数据不在该工作表的A列中,则循环变为
字符串
因此不会在循环内执行任何操作。解决方案-更明确地与您的范围。
如果该工作表的A列中有数据,则文本
<<Today>>
、<<Employee_Name>>
和<<Vacation_Used>>
不在文档中。解决方案-确保您打开的是正确的文档,并且您已将正确的占位符文本放在适当的位置,例如<<
而不是<
当你来保存PDF你会得到另一个错误-要解决这个问题,请参阅黑猫的解决方案。
修复所有这些问题,您的代码就可以正常工作了