如何从 Excel 工作表为 Word MailMerge 打开数据源

Question

我正在尝试使用 MailMerge 中的 OpenDataSource 自动创建 word 文档，并将之前保存数据的工作表用作源。

问题是每次调用 wdocSource.MailMerge.OpenDataSource 时 excel 都会暂停执行。进程 WINWORD.EXE 是运行但 Excel 没有继续，因为它正在等待某些事情发生，我必须终止进程以使其响应。

我检查了这些问题，但我无法让它工作：

Mailmerge from Excel using Word template VBA

Executing Word Mail Merge

Const sTempSourceSheet = "TempSourceSheet"

正在创建工作表源

Sub PrintArray(Data, SheetName, StartRow)
    Dim Destination As range
    Set Destination = range("A" & StartRow)
    Set Destination = Destination.Resize(1, UBound(Data))
    Destination.FormulaR1C1 = Data
End Sub

''''''''''''''''''''''''''''''''''''''''
' SaveSourceSheet
Public Sub SaveSourceSheet(cols() As String, arr() As String)
On Error GoTo error
    Dim ws As Worksheet

    With ActiveWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.count)).Name = sTempSourceSheet
    End With

    PrintArray cols, sTempSourceSheet, 1
    PrintArray arr, sTempSourceSheet, 2

done:
    Exit Sub

error:
    With ActiveWorkbook
        .Sheets(sTempSourceSheet).Delete
    End With

    Resume done
End Sub

以及运行 MailMerge 的代码

Sub Contract(wordfile As String)
    Dim wd As Object
    Dim wdocSource As Object
    Dim excelfile As String
    Dim strWorkbookName As String
    excelfile = ThisWorkbook.path & "\" & ThisWorkbook.Name
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    If wd Is Nothing Then
    Set wd = CreateObject("Word.Application")
    End If
    On Error GoTo 0

    Set wdocSource = wd.Documents.Open(wordfile)

    wdocSource.MailMerge.MainDocumentType = wdFormLetters

    wdocSource.MailMerge.OpenDataSource Name:= _
    excelfile, 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=" & excelfile & ";" & _
    "Mode=Read;Extended Properties=" & _
    "HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";" _
    , SQLStatement:="SELECT * FROM `TempSourceSheet$`", SQLStatement1:="", SubType:= _
    wdMergeSubTypeAccess

    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
    .Execute Pause:=False
    End With

    wd.visible = True
    wdocSource.Close SaveChanges:=False

    Set wdocSource = Nothing
    Set wd = Nothing
End Sub

有什么想法吗？

更新

在@macropod 提出的更改后我仍然有一些问题：

行 .OpenDataSource 中的字显示此消息：

任何选项都会引发错误：

我检查过 Excel 文件存在并且包含一个具有正确名称的工作表。

Answer 1

«问题是每次调用 wdocSource.MailMerge.OpenDataSource 时 excel 都会暂停执行。进程 WINWORD.EXE 是运行但 Excel 没有继续，因为它正在等待某些事情发生，我必须终止进程以使其响应。»

这表明您尝试打开的文档可能已经是邮件合并主文档，代码正在等待您响应 Word 在打开此类文档时产生的 SQL 查询。

或者，如果文档包含自动宏，它可能正在等待用户响应。

您的代码还包含：

ReadOnly:=False, LinkToSource:=True

应该是：

ReadOnly:=True, LinkToSource:=False

我还建议将提供商更改为：

Microsoft.ACE.OLEDB.12.0

试试下面的代码：

Sub Contract(wordfile As String)
Dim wdApp As Object, wdDoc As Object
Dim StrMMSrc As String: StrMMSrc = ActiveWorkbook.FullName
If Dir(wordfile) = "" Then
  MsgBox "Cannot find:" & vbCr & wordfile, vbExclamation
  Exit Sub
End If
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then
  Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
With wdApp
  .Visible = True
  .WordBasic.DisableAutoMacros
  .DisplayAlerts = 0 ' wdAlertsNone
  Set wdDoc = .Documents.Open(wordfile)
  With wdDoc
    With .MailMerge
      .MainDocumentType = wdFormLetters
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      .OpenDataSource Name:=StrMMSrc, ReadOnly:=True, AddToRecentFiles:=False, _
        LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
        "Data Source=StrMMSrc;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
        SQLStatement:="SELECT * FROM `TempSourceSheet$`", SubType:=wdMergeSubTypeAccess
      With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
      End With
      .Execute Pause:=False
    End With
    .Close SaveChanges:=False
  End With
End With
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

如何从 Excel 工作表为 Word MailMerge 打开数据源

How to OpenDataSource for Word MailMerge from Excel Worksheet

excel

vba

ms-word

mailmerge