我目前正在尝试使用VBA中的以下代码将表中的数据带入mailmerge word文档中,然后将各个合并另存为pdf。代码几乎可以做到这一点,但是当我在excel工作表上运行宏时,保存的pdf仅通过word文档引入了mergefield名称,而不是数据本身。
关于我可以从这里去哪里的任何想法?我当前正在使用Office2016。
Sub RunMailMerge()
Dim objWord
Dim objDoc
Dim StrFolder As String, StrName As String, i As Long, j As Long
Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
Const StrNoChr As String = """*./\:?|": StrName = "Easy.docx"
StrFolder = ThisWorkbook.Path & Application.PathSeparator
If Dir(StrFolder & strDocNm) = "" Then Exit Sub
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
With objWord
'Disable alerts to prevent an SQL prompt
.DisplayAlerts = wdAlertsNone
'Display Word - change this to False once the code is running correctly
.Visible = False
'Open the mailmerge main document - set Visible:=True for testing
Set objWord = .Documents.Open(Filename:=StrFolder & StrName, ReadOnly:=True,
AddToRecentFiles:=False, Visible:=False)
With objWord
With .MailMerge
'Define the mailmerge type
.MainDocumentType = wdFormLetters
'Define the output
.Destination = wdSendToNewDocument
.SuppressBlankLines = False
'Connect to the data source
.OpenDataSource Name:=strWorkbookName, _
ReadOnly:=True, _
LinkToSource:=False, _
AddToRecentFiles:=False, _
Format:=wdOpenFormatAuto, _
Connection:="User ID=Admin;DataSource=strWorkbookName;" & _
"Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM `Sheet1 SQLStatement:=", _
SubType:=wdMergeSubTypeAccess
'Process all eligible records
For i = 1 To .DataSource.RecordCount
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
'Exit if the field to be used for the filename is empty
If Trim(.DataFields("Tenant")) = "" Then Exit For
'StrFolder = .DataFields("Folder") & Application.PathSeparator
StrName = .DataFields("Tenant")
End With
.Execute Pause:=True
'Clean up the filename
For j = 1 To Len(StrNoChr)
StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
Next
StrName = "Letter - " & Trim(StrName)
'Save as a PDF
objWord.SaveAs Filename:=StrFolder & StrName & ".pdf", _
FileFormat:=wdFormatPDF, AddToRecentFiles:=False
Next i
'Disconnect from the data source
.MainDocumentType = wdNotAMergeDocument
End With
'Close the mailmerge main document
.Close False
End With
Call CloseAll
Set wdDoc = Nothing: Set wdApp = Nothing
End With
End Sub
Sub CloseAll()
Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End Sub
答案 0 :(得分:0)
您为什么要尝试通过VBA代码驱动邮件合并?您应该能够A)在Excel或Access中设置数据,B)在Word中设置模板并将其连接到数据源,C)运行邮件合并。除非您确实做某事,否则就不需要VBA。
由于似乎有些虐待狂迫使您艰难地做事,因此看来您的错误很可能出现在这里:
ContentType
首先:
Connection:="User ID=Admin;DataSource=strWorkbookName;" & _
"Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
SQLStatement:="SELECT * FROM `Sheet1
SQLStatement:=", _
SubType:=wdMergeSubTypeAccess
应该是
Connection:="User ID=Admin;DataSource=strWorkbookName;" & _
第二,您的Connection:="User ID=Admin;DataSource=" & strWorkbookName & ";" & _
参数是未终止的,而且我很确定SQLStatement
(不确定为什么在那里有多余的引号)不是引用“表格”的方式(即工作表)从Excel工作簿中进行选择时。 IIRC,应该为"Sheet1"
,因此:
"WorkBook$WorkSheet"
应该是这样的:
SQLStatement:="SELECT * FROM `Sheet1
该行之后是字符串的结尾
SQLStatement:="SELECT * FROM " & strWorkbookName & "$Sheet1", _
其中是实际SQL字符串的一部分,该字符串已发送到Excel中的数据库引擎。那是行不通的。
我的阅读方式,该行应为:
SQLStatement:=", _
您可能需要稍微调整一下,但是我认为这会让您走上正确的轨道。
答案 1 :(得分:0)
该代码本质上是我在其他地方发布的代码的副本(例如https://www.mrexcel.com/forum/general-excel-discussion-other-questions/713478-word-2007-2010-mail-merge-save-individual-pdf-files-post4796480.html#post4796480),但是为什么要添加对CloseAll的调用却是一个谜。
尽管如此,很明显,您还替换了部分代码,以修改代码以供后期绑定使用
:Dim wdApp As New Word.Application, wdDoc As Word.Document
具有:
Dim objWord
Dim objDoc
...
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
如果您始终坚持早期绑定,则代码将起作用。但是,现在,您的修改后的代码将后期绑定与命名的Word常量混合使用,这实际上仅适用于早期绑定。您需要使代码完全适应后期绑定,或者恢复为完全早期绑定的代码。