如何用vba实现word邮件合并主文档与数据源的路径自动匹配？

经常使用邮件合并的都会发现，一旦邮件合并的数据源移动了位置，之前做好的邮件合并就需要重新选择数据源。

在VBA中可以使用如下的代码实现word邮件合并主文档与excel数据源的路径自动匹配：

Private Sub Document_Open()
    Call QQ1722187970
End Sub
Private Sub Document_Close()
    Dim oMailMerge As MailMerge
    Dim oDoc As Document
    Dim oMailMergeDataSource As MailMergeDataSource
    Set oDoc = Word.ActiveDocument
    Set oMailMerge = oDoc.MailMerge
    '邮件合并对象
    With oMailMerge
        .MainDocumentType = wdNotAMergeDocument
    End With
End Sub
Sub QQ1722187970()
    Const xlUp = -4162
    Dim oMailMerge As MailMerge
    Dim oDoc As Document
    Dim oMailMergeDataSource As MailMergeDataSource
    Dim sPath As String
    Dim sName As String
    sPath = Word.ActiveDocument.Path & "\"
    sName = Dir(sPath & "*.xls*", vbNormal)
    Dim oExcel As Object
    Set oExcel = VBA.CreateObject("excel.application")
    Set oWB = oExcel.workbooks.Open(sPath & sName)
    Dim oWK
    Set oWK = oWB.worksheets(1)
    sTableName = oWK.Name
    iRow = oWK.Range("a65536").End(xlUp).Row
    '此处修改为excel文档的名称即可
    Set oDoc = Word.ActiveDocument
    Set oMailMerge = oDoc.MailMerge
    '连接字符串
    sConStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sPath & sName & ";Extended Properties='HDR=YES;IMEX=1'"
    sSQL = "SELECT * FROM [" & sTableName & "$a2:o" & iRow & "]"
    Debug.Print sSQL
    '邮件合并对象
    With oMailMerge
        .MainDocumentType = wdNotAMergeDocument
        .MainDocumentType = wdFormLetters
        'Name参数表示excel数据源的完整路径, LinkToSource参数表示是否每次打开word文档都执行sql命令,Revert表示如果数据源已经打开是否重新打开
        .OpenDataSource Name:=sPath & sName, _
        LinkToSource:=False, _
        Revert:=True, _
        Connection:=sConStr, _
        SQLStatement:=sSQL
    End With
End Sub