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

ehxuflar  于 2023-11-20  发布在  其他
关注(0)|答案(1)|浏览(109)

我们有一个Excel文档和Word文档之间的邮件合并设置。我将文档保存在同步团队文件夹的同一个文件夹中,供每个人访问。
如果我打开Word文档,我可以在SQL命令上单击“是”,然后它就会打开。
对于我的同事来说,每次打开Word文件时,它都会提示查找收件人列表。他们甚至必须连续选择Excel文件两次才能连接。
有没有一种方法可以指定Word的文件应该始终使用,这也适用于我的同事?
由于同步的Teams文件夹的路径位置始终以“C:\Users\username”开头,因此每个同事的文件夹位置都不同。

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

字符串

wnrlj8wa

wnrlj8wa1#

因此,在互联网和jonsson的帮助下,我设法编写了一段代码来解决这个问题。environ 2函数获取本地文件路径,该路径可能因用户而异,并且使用replace函数可以删除和替换此路径中任何不需要的部分。在“XXX”处,在用户名之后指定路径位置的其余部分。也不要忘记替换“General将“Template.xlsx”添加到您的文件名中,并将SQL语句添加到您的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引导我在正确的方向来解决这个问题!

相关问题