Microsoft Word 邮件合并数据源自动定位

Question

我写了一个 Excel > Word 邮件合并，其中 word 文档是邮件合并模板。

目前 Excel 文件（数据源）的位置必须进行硬编码。

我希望能够移动关于网络的文件，只要它们在同一个文件夹中，所以它识别数据源仍然是excel文件。

我目前有这段我认为可以工作的代码。当 word 文档在任何时候打开时，它都会通过查找文件的当前目录并查找文件名 PM MailMerge.xlsm 来重新创建数据源。

然后当它被创建后，一个消息框应该会显示新的邮件合并数据源。

这可行，但是当我将这两个文件移动到任何其他文件夹时，它会失败并说找不到数据源。

代码：

Private Sub Document_Open()

Dim strBook As String
Dim strBookName As String
Dim strDataSource As String

strBookName = "\PM MailMerge.xlsm"
strBook = ActiveDocument.Path & strBookName
strDataSource = ActiveDocument.MailMerge.DataSource.Name

ActiveDocument.MailMerge.OpenDataSource Name:= _
strBook, _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
WritePasswordDocument:="", _
WritePasswordTemplate:="", _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=strBook;Mode=Read;Extended                       Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry       Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:D", _
SQLStatement:="SELECT * FROM `Merge$`", _
SQLStatement1:="", SubType:= _
wdMergeSubTypeAccess

MsgBox "Current Datasource -   " + strDataSource

End Sub

Answer 1

失败是因为 Word 在执行 Document_Open 之前尝试连接到现有数据源。但是，究竟会发生什么以及您看到什么至少取决于以下因素：

1. 文档中存储的数据源信息是否还在 有效（即原始 .xlsm 是否仍然存在，例如 正确的工作表名称仍在其中）
2. 您是手动打开 Word 文档还是通过 OLE 打开 自动化
3. here 描述的 SQLSecurityCheck 注册表设置是否为 处于默认状态（即不存在或设置为 1），或设置为 0
4. 在 OLE 自动化的情况下，Word Applicaiotn 对象的 DisplayAlerts 属性设置为 wdAlertsAll 或 wdAlertsNone

粗略地说……

如果 Word 尝试查找的数据源仍然存在，在除一种情况之外的所有情况下，只要用户对他们看到的任何安全提示响应“是”，Word 就会建立连接。例外情况是，如果 SQLSecurityCheck 不存在或设置为 1（即默认值），则通过 OLE 自动化打开文档，并且 DisplayAlerts 设置为 wdAlertsNone，不显示任何对话框并且不打开数据源。

如果 Word 尝试查找的数据源不存在（例如已被移动），在所有情况下，除了一种情况，用户都会看到错误对话框。如果他们对该对话框的响应是识别有效的数据源，则文档将具有新的数据源。同样，例外情况是 SQLSecurityCheck 是默认值，通过 OLE 打开文档，并且 DisplayAlerts 设置为 wdAlertsNone。在这种情况下，不会显示任何对话框，也不会打开数据源。

开发人员的一个问题是，如果 SQLSecurityCheck 值已更改为 0（通常是为了让用户不必一直回答安全检查问题），他们无法避免在数据源不存在时弹出用户对话框。

但是，只要用户能够看到并响应 Word 在连接到数据源时显示的任何对话框，用户最终会 (a) 获得一个附加了数据源的打开文档，或者(b) 一个没有附加数据源的打开文档（或者可以说是其他一些混乱，例如用户试图结束 Word 进程等）。如果发生这两种情况中的任何一种，则应该运行 Document_Open 代码，并且 Word 应该最终连接到您想要的数据源。 （尽管在某些情况下，当 Word 已使用其他方法连接到现有数据源（如文本文件）时，尝试连接到现有数据源可能会导致错误。）

顺便说一句，

• 对于与 Excel 工作簿的 OLE DB 连接，您应该能够 省略 OpenDataSOurce 调用中的所有参数，除了 Name 和 SQL 语句。
• AFAICS 目前您的代码将始终报告 现有数据源（如果 Word 尚未将其删除） Document_Open 执行。您需要将作业移至 调用 OpenDataSource 下面的 strDataSource 以显示新名称。但 也许我错过了那里的重点！

Answer 2

我遇到了同样的问题。我解决了它： 1. MainDocumentType = wdNotAMergeDocument （必须设置为普通文档，否则word总是在打开时询问）。 2.启动vba函数后读取当前文档路径并运行附加函数：

enter code here

 Function Start_MMerge(xdoc As Document, SBD_Name As String) As Integer
 On Error GoTo Start_MMergeError
 Dim vFile As String
 vFile = Dir(SBD_Name) 'prüft, ob es die Datei SBD_Name überhaupt gibt
 If Len(vFile) <> 0 Then

    xdoc.MailMerge.MainDocumentType = wdFormLetters 

    xdoc.MailMerge.OpenDataSource Name:= _
    SBD_Name, _
    ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
    AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
    WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
    Format:=wdOpenFormatAuto, Connection:= _
    "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=" & SBD_Name _
    & ";Mode=Read;Extended    Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";
    Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Da" _
    , SQLStatement:="SELECT * FROM `Adressen$` WHERE [E-Mail senden]='nein'", SQLStatement1:="", 
    SubType:=wdMergeSubTypeAccess
    xdoc.MailMerge.MainDocumentType = wdFormLetters

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

    Start_MMerge = -1
 Else
    Start_MMerge = 0
 End If

 Start_MMergeExit:
     xdoc.MailMerge.MainDocumentType = wdNotAMergeDocument

     Exit Function
 Start_MMergeError:
     Start_MMerge = 0
     Resume Start_MMergeExit

 End Function

enter code here