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

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

目前，excel文件（数据源）的位置必须硬编码

我希望能够在网络上移动文件，只要它们彼此位于同一文件夹中，这样它就可以识别数据源仍然是excel文件

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

然后，当它被创建时，一个消息框应该显示新的mailmerge数据源

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

代码：

---

它失败是因为Word在执行Document_Open之前尝试连接到现有数据源。但是，发生的事情和看到的情况至少取决于以下几点：

文档中存储的数据源信息是否仍然有效 有效（例如，原始.xlsm是否仍然存在，例如 正确的图纸名称（仍在其中）

无论是手动打开Word文档还是通过OLE打开Word文档 自动化

是否描述了SQLSecurityCheck注册表设置 处于默认状态（即缺席或设置为1），或设置为0

在OLE自动化的情况下，单词applicationn对象是否 DisplayAlerts属性设置为wdAlertsAll或WDAlertsOne

粗略地说

如果Word试图查找的数据源仍然存在，则在除一个之外的所有情况下，只要用户对他们看到的任何安全提示回答“是”，Word都将建立连接。例外情况是，如果SQLSecurityCheck不存在或设置为1（即默认值），则通过OLE Automation打开文档，并且DisplayAlerts设置为WDAlertsOne，则不显示任何对话框，也不打开数据源

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

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

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

顺便说一下

• 对于与Excel工作簿的OLE DB连接，您应该能够 省略OpenDataSOurce调用中除Name和 SQLStatement
• AFAICS此时您的代码将始终报告 现有数据源（如果Word在此时尚未将其删除） 文档_Open执行。您需要将分配移动到 在OpenDataSource调用下面显示新名称的strDataSource。但是 也许我没有抓住要点

---

我也遇到了同样的问题。我用以下方法解决了它： 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

在此处输入代码
函数Start_MMerge（xdoc作为文档，SBD_名称作为字符串）作为整数
错误转到启动\u mmergeer时出错
将vFile设置为字符串
vFile=Dir（SBD_Name）'prüft，ob es die Datei SBD_Nameüberhaut gibt
如果Len（vFile）为0，则
xdoc.MailMerge.MainDocumentType=wdFormLetters
xdoc.MailMerge.OpenDataSource名称：=_
SBD_名称_
ConfirmConversions:=False，只读：=False，LinkToSource:=True_
AddToRecentFiles:=False，PasswordDocument:=“”，PasswordTemplate:=“”_
WritePasswordDocument:=“”，WritePasswordTemplate:=“”，Revert:=False_
格式：=wdOpenFormatAuto，连接：=_
“Provider=Microsoft.ACE.OLEDB.12.0；用户ID=Admin；数据源=”&SBD_Name_
&“模式=读取；扩展属性=”HDR=是；IMEX=1；“”；Jet OLEDB:系统数据库=“””；
Jet OLEDB:注册表路径=“”；Jet OLEDB:引擎类型=35；Jet OLEDB:Da_
，SQLStatement:=“从`Adressen$`WHERE[E-Mail senden]='nein'”中选择*，SQLStatement1:=”，
子类型：=wdmergesubiteaccess
xdoc.MailMerge.MainDocumentType=wdFormLetters
使用xdoc.MailMerge
.Destination=wdSendToNewDocument
.suppress blanklines=True
使用.DataSource
.FirstRecord=wdDefaultFirstRecord
.LastRecord=wdDefaultLastRecord
以
.执行暂停：=False
以
开始时间=-1
其他的
开始时间=0
如果结束
开始退出：
xdoc.MailMerge.MainDocumentType=wdNotAMergeDocument
退出功能
开始错误：
开始时间=0
恢复启动\u MMergeExit
端函数
在这里输入代码

我正在使用Word 2003（11.0）的自动化功能。我在SQLSecurityCheck方面运气不佳，但启用警报在我的情况下很有帮助。

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