如何让我的 Mailmerge VBA 例程不显示对话框并自动运行

Question

我正在使用 Office 2016 尝试使用 VBA 自动发送电子邮件。

例程一次将 1 条记录导出到电子表格，并使用电子表格调用 Word 邮件合并。

Word 文档随后保存为 PDF，并发送包含 PDF 的电子邮件。

我遇到的问题是例程不断为每条记录生成相同的对话框，我希望它自动运行。

我遇到的错误是

对话框

我使用的代码是

acExport, _ 
acSpreadsheetTypeExcel12Xml, _ 
"Updatedetailsone", _ 
mailmergexls, True 

' 
' Merge Word document with mailmerge spreadsheet file 
' 

Set wordApp = CreateObject("Word.Application") 
wordApp.Visible = True 

Set wordDoc = wordApp.Documents.Open(mailmergedoc) 
With wordDoc.MailMerge 
  .MainDocumentType = wdMailingLetters 
  .OpenDataSource Name:=mailmergexls, _ 
  ConfirmConversions:=False, _ 
  ReadOnly:=False, _ 
  LinkToSource:=False, _ 
  AddToRecentFiles:=False, _ 
  Connection:="Updatedetailsone" 
  .Destination = wdSendToNewDocument 
  .Execute 
  .MainDocumentType = wdNotAMergeDocument 
End With 

' 
' Delete existing membership form PDF file 
' Create new membership form PDF file with current record 
' 

Kill mailmergepdf 

wordApp.ActiveDocument.SaveAs2 mailmergepdf, 17 
' 
' Close and clean up Word documents 
' 
For Each wordDoc In wordApp.Documents 
  wordDoc.Close SaveChanges:=False 
  Next wordDoc 
wordApp.Quit 

Set wordDoc = Nothing 
Set wordApp = Nothing

任何帮助将不胜感激。

我希望例程自动选择第一个表而不提示。

Answer 1

我原本想详细说明如何从 Word 邮件合并主文档直接连接到 Access 表。

这并不简单，因为当你开发时，Word经常报告无法连接数据，因为有人将数据库置于某种状态。据我所知，造成这种情况的一件事是对 VBA 模块的“任何更改”，这意味着您必须在测试代码中所做的“任何更改”之前保存数据库（尽管您可能知道您是否使用的是第三方） VB 编辑器插件，请注意，他们也可以“在幕后”进行更改） 我还发现，当您在 CurrentDB 中的 Access VBA 中更新表数据时，访问往往会锁定内容。通过在 Word .OpenDataSource 调用中使用连接文件来指定合适的打开选项（共享只读或其他），可以解决这个问题。然而，避免该问题的另一种方法 AFAICS 是在不同的 .accdb 文件中创建一个表并将其用作数据源。因此，下面的代码是我的建议，告诉您如何避免使用 Excel。 本部分不涉及自动化 Outlook 的部分，但也许您可以通过复制我的方法来避免多次调用 CreateObject。

顺便说一句，这还没有经过充分测试，我确信常规的 Access VBA 编码器可以改进这一点。 您需要创建一个 Access DB .accdb - 在我的示例中，它在 c: empdb.accdb 中调用，并且您需要修改其他常量值。

Option Compare Database

Const TempDBFullName As String = "c:\a\tempdb.accdb"
Const RSAllName As String = "Updatedetailsall2"
Const RSOneName As String = "Updatedetailsone"
Const JuniorMMMDFullName As String = "c:\a\junior.docx"
Const AdultMMMDFullName As String = "c:\a\adult.docx"
Const MailMergePDF As String = "c:\a\merged.pdf"
Sub mysub()

Dim wordApp As Word.Application ' Object if you are using late binding
Dim wordDoc As Word.Document ' Object
' MMMD = Mail Merge Main Document
Dim JuniorMMMD As Word.Document ' Object
Dim AdultMMMD As Word.Document ' Object
On Error GoTo problem

Set RSAll = CurrentDb.OpenRecordset(" SELECT * FROM " & RSAllName)
With RSAll
  If .RecordCount > 0 Then ' first time through, Word (and probably Outlook too).
    ' You could probably also create your TempDB but I hven't done that here.
    Set wordApp = CreateObject("Word.Application")
    With wordApp
      .Visible = True
      ' Open your MMMDs once, at the beginning
      Set JuniorMMMD = .Documents.Open(JuniorMMMDFullName)
      Set AdultMMMD = .Documents.Open(AdultMMMDFullName)
    End With
  End If
  .MoveFirst ' probably not needed
  Do Until .EOF
    CurrentDb.Execute _
      " DELETE FROM " & RSOneName
    ' Insert into our temp database - helps solve locking problems
    ' You *could* insert the record directly into the temp db, using the following IN clause before the SELECT clause, and removing the TransferDatabase
    ' statement, but to do that, the table already has to exist with the correct structure, which we can avoid because TransferDatabase
    ' creates the structure. An Access person would probably know what's quickest if that's a concern.
    '
    CurrentDb.Execute " INSERT INTO " & RSOneName & _
      " SELECT * FROM " & RSAllName & _
      " WHERE ID = " & !ID
      
   ' That IN clause:
   ' " IN """ & TempDBFullName & """" & _

    DoCmd.TransferDatabase transfertype:=acExport, databasetype:="Microsoft Access", databasename:=TempDBFullName, objecttype:=acTable, Source:=RSOneName, Destination:=RSOneName
    
    If ![Membership Category] = "Junior Player" Or ![Membership Category] = "Junior Player (Sibling)" Then
      Call MergeOne(JuniorMMMD)
    Else
      Call MergeOne(AdultMMMD)
    End If
    .MoveNext
  Loop
  .Close
End With

problem: ' and final processing
Debug.Print Err.Description, Erl
If Not (wordApp Is Nothing) Then
  wordApp.Quit savechanges:=wdDoNotSaveChanges
  Set wordApp = Nothing
End If
If Not (RSAll Is Nothing) Then
  For Each x In CurrentDb.Recordsets
    If x.Name = RSAllName Then
      RSAll.Close
    End If
  Next
  Set RSAll = Nothing
End If

End Sub

Sub MergeOne(MMMD As Word.Document)
With MMMD
  With .MailMerge
    .MainDocumentType = 0 ' wdFormLetters
    .Destination = 0 ' wdSendToNewDocument
    .OpenDataSource _
      Name:=TempDBFullName, _
      sqlstatement:="SELECT * FROM [" & RSOneName & "]"
    .Execute
    .MainDocumentType = -1 ' wdNotAMergeDocument
  End With
  'Kill MailMergePDF
  With .Application.ActiveDocument
    .SaveAs2 FileName:=MailMergePDF, FileFormat:=17 'wdFormatPDF
    .Close savechanges:=0 ' wdDoNotSaveChanges
  End With
End With
End Sub