如何获取WorkbookConnections读取文件的完整路径名

针对你需要提取Excel中文本文件类型连接的源路径并附加到邮件的需求，可以通过判断连接类型并转换为TextConnection对象来获取路径，以下是具体实现方案：

1. 提取文本连接的源文件路径 #

普通的WorkbookConnection对象不会直接暴露源路径，但文本文件对应的连接类型为xlConnectionTypeText，我们可以将其转换为TextConnection对象，解析其Connection属性来获取路径：

Sub GetConnectionSourcePaths()
    Dim conn As WorkbookConnection
    Dim textConn As TextConnection
    Dim sourcePath As String
    
    For Each conn In ThisWorkbook.Connections
        ' 仅处理文本类型的连接
        If conn.Type = xlConnectionTypeText Then
            Set textConn = conn.TextConnection
            ' 解析连接字符串：格式通常为 "TEXT;C:\路径\文件.csv"
            sourcePath = Split(textConn.Connection, ";")(1)
            ' 移除路径前后的双引号（部分场景下会自动添加）
            sourcePath = Replace(sourcePath, """", "")
            Debug.Print "连接名称: " & conn.Name & vbTab & "源文件路径: " & sourcePath
        Else
            Debug.Print "连接名称: " & conn.Name & vbTab & "非文本类型连接，跳过处理"
        End If
    Next conn
End Sub

2. 直接将源文件附加到邮件 #

结合Outlook VBA，可以直接遍历连接并将存在的源文件添加到邮件附件中：

Sub AttachConnectionSourcesToEmail()
    Dim conn As WorkbookConnection
    Dim textConn As TextConnection
    Dim sourcePath As String
    Dim olApp As Object
    Dim olMail As Object
    
    ' 初始化Outlook对象
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0
    
    Set olMail = olApp.CreateItem(0) ' 创建新邮件
    
    With olMail
        .To = "收件人邮箱@xxx.com"
        .Subject = "Excel连接对应源数据文件"
        .Body = "以下是当前Excel文件关联的源数据文件：" & vbCrLf & vbCrLf
        
        ' 遍历所有连接，添加有效附件
        For Each conn In ThisWorkbook.Connections
            If conn.Type = xlConnectionTypeText Then
                Set textConn = conn.TextConnection
                sourcePath = Split(textConn.Connection, ";")(1)
                sourcePath = Replace(sourcePath, """", "")
                
                ' 检查文件是否存在，避免添加无效路径
                If Dir(sourcePath) <> "" Then
                    .Attachments.Add sourcePath
                    .Body = .Body & "✅ " & sourcePath & vbCrLf
                Else
                    .Body = .Body & "❌ " & sourcePath & "（文件不存在或路径无效）" & vbCrLf
                End If
            End If
        Next conn
        
        .Display ' 显示邮件窗口（如需直接发送替换为 .Send）
    End With
    
    ' 释放对象
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

注意事项 #

• 需确保Excel信任中心允许VBA访问Outlook，否则会弹出权限提示
• 部分旧版本Excel的文本连接字符串格式可能略有差异，若解析出错可打印textConn.Connection查看原始字符串后调整拆分逻辑
• 网络驱动器路径需确保当前用户有访问权限，否则会提示文件不存在

内容的提问来源于stack exchange，提问作者Davidson