在 Microsoft Teams 文件夹中为具有不同路径的同事从邮件合并打开收件人列表

Question

我们在 Excel 文档和 Word 文档之间设置了邮件合并。我将文档保存在 Synced Teams 文件夹的同一文件夹中，供每个人访问。

如果我打开 Word 文档，我可以在 SQL 命令上单击“是”，然后它就会打开。
对于我的同事来说，每次打开 Word 文件时，它都会提示查找收件人列表。他们甚至必须在连接之前连续选择 Excel 文件两次。

是否有一种方法可以为 Word 指定应始终使用哪个文件，并且该方法也适用于我的同事？

每个同事的文件夹位置都不同，因为同步 Teams 文件夹的路径位置始终以“C:\Users\用户名”开头。

Private Sub Document_Open()
    
    Dim fs As Object
    Dim filename As String
    
    ' Create a FileSystemObject
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    ' Set the path to the folder containing the data source file
    Dim folderPath As String
    folderPath = ThisDocument.Path
    
    ' Look for the data source file in the folder
    Dim file As Object
    For Each file In fs.GetFolder(folderPath).Files
        If file.Name Like "*General Template.xlsx" Then
            filename = file.Path
            Exit For
        End If
    Next file
    
    If filename = "" Then
        MsgBox "Could not find the data source file.", vbExclamation, "Error"
        Exit Sub
    End If
    
    ' Use the file path in the Mail Merge
    ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:=filename, _
        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=" & filename & _
        ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1""", _
        SQLStatement:="SELECT * FROM `General$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
    
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
    
End Sub

Answer 1

因此，在互联网和 jonsson 的帮助下，我成功地编写了解决此问题的代码。 environ 2 函数获取本地文件路径，该路径可能因用户而异，并且使用替换功能，您可以删除和替换该路径中任何不需要的部分。在“XXX”处指定用户名后路径位置的其余部分。另外，不要忘记将“General Template.xlsx”替换为您的文件名，并将 SQLStatement 替换为您的 Excel 选项卡名称：

Private Sub Document_Open()

Dim fs As Object
Dim filename As String

' Create a FileSystemObject
Set fs = CreateObject("Scripting.FileSystemObject")

' Set the path to the folder containing the data source file
Dim folderPath As String
folderPath = Replace(Replace(Environ(2), "APPDATA=", ""), "AppData\Roaming", "XXX")

' Look for the data source file in the folder
Dim file As Object
For Each file In fs.GetFolder(folderPath).Files
    If file.Name Like "*General Template.xlsx" Then
        filename = file.ShortPath
        Exit For
    End If
Next file

If filename = "" Then
    MsgBox "Could not find the data source file.", vbExclamation, "Error"
    Exit Sub
End If

' Use the short file path in the Mail Merge
ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
ActiveDocument.MailMerge.OpenDataSource Name:=filename, _
    SQLStatement:="SELECT * FROM `General$`"

ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle 
    
End Sub

为了确保保存为模板时仍然有效，请在 Private Sub Document_New() 中添加完全相同的代码，现在每次打开模板时都会触发该事件！

非常感谢 jonsson 指导我朝正确的方向解决问题！