邮件合并的收件人列表无法为在 Microsoft Teams 文件夹中工作的同事正确打开

Question

我们在 Excel 文档和 Word 文档之间设置了邮件合并。我已将文档保存在 Synced Teams 文件夹中的同一文件夹中，供所有人访问。如果我打开 Word 文档，我可以在 SQL 命令上单击是，它可以正常打开。对于我的其他同事，每次打开 Word 文件时都会提示查找收件人列表。奇怪的是，他们甚至必须连续两次选择 Excel 文件才能按预期连接。我想知道是否有一种方法可以为 Word 指定它应该始终使用的文件，该文件也适用于我的同事，因为该文档经常使用。

我从互联网上尝试了一堆 VBA 脚本，但似乎没有任何效果。有可能吗？由于同步 Teams 文件夹的路径位置始终以“C:\Users\username”开头，因此每个同事的文件夹位置都不同？

''私有子文档_打开()

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

结束子

''

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 在正确的方向上指导我解决问题！