使用VBA将Infopath附件下载到硬盘中

Sub DownloadAttachments()
    Dim xmlDoc As MSXML2.DOMDocument
    Dim xmlNodeList As MSXML2.IXMLDOMNodeList
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim attachmentNode As MSXML2.IXMLDOMNode
    Dim attachmentURL As String
    Dim savePath As String
    
    ' 设置保存路径
    savePath = "C:\Attachments\"
    
    ' 创建XML文档对象
    Set xmlDoc = New MSXML2.DOMDocument
    
    ' 加载Infopath表单XML数据
    xmlDoc.Load "C:\Path\To\Your\Form.xml"
    
    ' 获取所有附件节点
    Set xmlNodeList = xmlDoc.SelectNodes("//my:Attachments/my:Attachment")
    
    ' 遍历附件节点
    For Each xmlNode In xmlNodeList
        ' 获取附件URL
        Set attachmentNode = xmlNode.SelectSingleNode("my:AttachmentURL")
        attachmentURL = attachmentNode.Text
        
        ' 下载附件到硬盘
        DownloadFile attachmentURL, savePath
    Next xmlNode
    
    MsgBox "附件下载完成！"
End Sub

Sub DownloadFile(url As String, savePath As String)
    Dim http As Object
    Dim stream As Object
    
    ' 创建HTTP请求对象
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    ' 发送HTTP请求
    http.Open "GET", url, False
    http.send
    
    ' 创建二进制流对象
    Set stream = CreateObject("ADODB.Stream")
    
    ' 设置流类型为二进制
    stream.Type = 1
    
    ' 打开流
    stream.Open
    
    ' 写入流
    stream.Write http.responseBody
    
    ' 保存文件到硬盘
    stream.SaveToFile savePath & GetFileNameFromURL(url), 2
    
    ' 关闭流
    stream.Close
    
    ' 释放对象
    Set stream = Nothing
    Set http = Nothing
End Sub

Function GetFileNameFromURL(url As String) As String
    Dim parts() As String
    
    ' 使用"/"分割URL
    parts = Split(url, "/")
    
    ' 返回最后一个分割部分作为文件名
    GetFileNameFromURL = parts(UBound(parts))
End Function