使用Word模板VBA从Excel进行邮件合并 [英] Mailmerge from Excel using Word template VBA
问题描述
我创建了一个用户窗体，您可以在其中将记录标记为进行中"，已完成"和未完成".
这将反映在工作表上，如下所示:
标记为进行中"的记录在状态栏中将带有字母"P". 标记为已完成"的记录在状态栏中将带有字母"Y". 标记为未完成"的记录在状态栏中将带有字母"N".
DataSheet http://im39.gulfup.com/VZVxr.png ！
我想使用用户表单上的以下按钮运行邮件合并:
用户界面http://im39.gulfup.com/98isU.png ！
我已经为字段创建了此工作模板.
文档http://im39.gulfup.com/4WMLh.png ！
此单词模板文件"MyTemplate"将与excel文件位于同一目录中.
我试图弄清楚如何: (1)通过过滤状态"列来选择收件人，因此，如果用户按下第一个按钮，它将仅对状态列中带有"P"的记录运行邮件合并.
(2)运行mailmerge而不显示Microsoft Word，而仅显示另存为"对话框，用户可以在其中选择保存文件的位置.
(3)此文件应以PDF格式保存.
我正在运行Office 2013，到目前为止，我的代码是零碎的，尝试运行它时没有运气. 我已经上传了我要处理的数据: MyBook: https://db.tt/0rLUZGC0 我的模板: https://db.tt/qPuoZ0D6
任何帮助将不胜感激. 谢谢.
(1)我使用的是WHERE子句(在OpenDataSource上，您可能不需要所有这些选项)
' setup the SQL
Dim sSQLModel As String, sSQLWhere As String
sSQLModel = " Where ( AssignLtrType = 'T1' or AssignLtrType = 'T2' ) ;"
' replace the appropriate value(s)
sSQLWhere = sSQLModel ' never replace in the model
sSQLWhere = Replace(sSQLWhere, "T1", mydatavariable)
' open the MERGE
doc.MailMerge.OpenDataSource Name:=sIn, _
ConfirmConversions:=False, readOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" & _
"User ID=Admin;" & _
"Data Source=" & sXLSPathFile & ";" & _
"Mode=Read;Extended Properties=" & _
"HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" _
, SQLStatement:="SELECT * FROM `Detail$`", _
SQLStatement1:=sSQLWhere, _
SubType:=wdMergeSubTypeAccess
' do the MERGE
With doc.MailMerge
.Destination = wdSendToPrinter
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
(2)在执行上述操作之前，请使文档可见(或不可见)
' setup the template document
Dim doc As Word.Document
Set doc = wrdApp.Documents.Add(sPathFileTemplate)
wrdApp.Visible = True ' you can say False
(3)我有Adobe PDF作为打印机(注册表例程来自网络-Google).将其放在OpenDataSource之前.
' Get current default printer.
SetDefaultPrinter "Adobe PDF"
'Create the Registry Key where Acrobat looks for a file name
CreateNewRegistryKey HKEY_CURRENT_USER, _
"Software\Adobe\Acrobat Distiller\PrinterJobControl"
'Put the output filename where Acrobat could find it
SetRegistryValue HKEY_CURRENT_USER, _
"Software\Adobe\Acrobat Distiller\PrinterJobControl", _
wrdApp.Application.Path & "\WINWORD.EXE", sPathFilePDF
在SQL中，将标签页名称从Detail $更改为yourTab $(需要在$后面加上)
稍后添加-
Dim sIn As String
sIn = SelectAFile(sInitial:=sDriveSAO, sTitle:=" XLS file")
If (sIn = "" Or sIn = "False") Then Exit Sub
和Google for SelectAFile
增加了1/22尾部
' ============= added ===========
Dim xls As Excel.Application ' for me, because I am running in MSAccess as mdb
Set xls = New Excel.Application
Dim wrdApp As Word.Application ' for you, to have WORD running
Set wrdApp = New Word.Application
Dim sPathFileTemplate As String
sPathFileTemplate = xls.GetOpenFilename(" docx file,*.docx", , "Template file")
' ============= added ===========
' changed you only need one variable
sSQLModel = " Where ( Status = 'T1' ) ;"
' changed replace, possibly with some screen value
sSQLWhere = Replace(sSQLWhere, "T1", "P")
' changed because your tab is named Sheet1
, SQLStatement:="SELECT * FROM `Sheet1$`", _
' ============= added ===========
doc.Close False
Set doc = Nothing
wrdApp.Quit False
Set wrdApp = Nothing
' ============= added ===========
I have created a Userform where you can flag records as "In Progress", "Completed", and "Not Completed".
This will reflect on the sheet as below:
Records marked as "In Progress" will have the letter "P" in the status column. Records marked as "Completed" will have the letter "Y" in the status column. Records marked as "Not Completed" will have the letter "N" in the status column.
DataSheet http://im39.gulfup.com/VZVxr.png!
I want to run a mailmerge using the below buttons on the user form:
Userform http://im39.gulfup.com/98isU.png!
I have created this work template for the fields.
Document http://im39.gulfup.com/4WMLh.png!
This word template file called "MyTemplate" will be in the same directory as the excel file.
I am trying to figure out how: (1) Select recepients by filtering the "Status" column, so if the user pressed the first button, it will run the mail merge only for records with "P" in the status column.
(2) Run mailmerge without displaying Microsoft Word and only displaying the "Save As" dialog where the user can select where to save the file.
(3) This file should be saved in PDF format.
I am running Office 2013 and so far I have the code in bits and pieces and had no luck when trying to run it. I have uploaded the data I am trying to work on: MyBook: https://db.tt/0rLUZGC0 MyTemplate: https://db.tt/qPuoZ0D6
Any help will be highly appreciated. Thanks.
(1) What I use is the WHERE clause (on the OpenDataSource, you probably don't need all those options)
' setup the SQL
Dim sSQLModel As String, sSQLWhere As String
sSQLModel = " Where ( AssignLtrType = 'T1' or AssignLtrType = 'T2' ) ;"
' replace the appropriate value(s)
sSQLWhere = sSQLModel ' never replace in the model
sSQLWhere = Replace(sSQLWhere, "T1", mydatavariable)
' open the MERGE
doc.MailMerge.OpenDataSource Name:=sIn, _
ConfirmConversions:=False, readOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";" & _
"User ID=Admin;" & _
"Data Source=" & sXLSPathFile & ";" & _
"Mode=Read;Extended Properties=" & _
"HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" _
, SQLStatement:="SELECT * FROM `Detail$`", _
SQLStatement1:=sSQLWhere, _
SubType:=wdMergeSubTypeAccess
' do the MERGE
With doc.MailMerge
.Destination = wdSendToPrinter
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
(2) Prior to the above, make the doc Visible (or Invisible)
' setup the template document
Dim doc As Word.Document
Set doc = wrdApp.Documents.Add(sPathFileTemplate)
wrdApp.Visible = True ' you can say False
(3) I have Adobe PDF as a Printer (the registry routines were from the web--Google them). Put this prior to OpenDataSource.
' Get current default printer.
SetDefaultPrinter "Adobe PDF"
'Create the Registry Key where Acrobat looks for a file name
CreateNewRegistryKey HKEY_CURRENT_USER, _
"Software\Adobe\Acrobat Distiller\PrinterJobControl"
'Put the output filename where Acrobat could find it
SetRegistryValue HKEY_CURRENT_USER, _
"Software\Adobe\Acrobat Distiller\PrinterJobControl", _
wrdApp.Application.Path & "\WINWORD.EXE", sPathFilePDF
In the SQL, change the tab name from Detail$ to yourTab$ (needs trailing $)
added later--
Dim sIn As String
sIn = SelectAFile(sInitial:=sDriveSAO, sTitle:=" XLS file")
If (sIn = "" Or sIn = "False") Then Exit Sub
and Google for SelectAFile
added 1/22 aft
' ============= added ===========
Dim xls As Excel.Application ' for me, because I am running in MSAccess as mdb
Set xls = New Excel.Application
Dim wrdApp As Word.Application ' for you, to have WORD running
Set wrdApp = New Word.Application
Dim sPathFileTemplate As String
sPathFileTemplate = xls.GetOpenFilename(" docx file,*.docx", , "Template file")
' ============= added ===========
' changed you only need one variable
sSQLModel = " Where ( Status = 'T1' ) ;"
' changed replace, possibly with some screen value
sSQLWhere = Replace(sSQLWhere, "T1", "P")
' changed because your tab is named Sheet1
, SQLStatement:="SELECT * FROM `Sheet1$`", _
' ============= added ===========
doc.Close False
Set doc = Nothing
wrdApp.Quit False
Set wrdApp = Nothing
' ============= added ===========
这篇关于使用Word模板VBA从Excel进行邮件合并的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
