首页 文章

在Outlook中使用VBA自动下载并将链接的PDF文件存储在文件夹(不是附件)中

提问于
浏览
0

第一篇文章,如果有人知道答案,我将非常感激 . 我发现的最接近我需要的是这个链接:

Using VBA in Outlook to Save File on Web/URL/Hyperlink

基本上,为了给我的问题提供背景,我经常使用一个系统来生成各种报告,然后通过电子邮件发送给我 . 但是,电子邮件本身并不包含附件,而是包含在库存表单中,其中包含与所涉及的PDF文件不同的链接 . 我想运行一个VBA脚本,它将在电子邮件中搜索适合某种形式的链接(即,ID号之前的第一部分将始终保持不变),然后下载链接指向预先指定的PDF我电脑上的文件夹 .

我认为上面链接中的第二篇文章接近我需要的内容,但是我希望能够解析变量URL . 例如,URL将采用类似于以下的形式:

http://example.text/here/Download.aspx?FileID=0123456789

每封电子邮件的最后编号都会发生变化 . 该数字包含在主题 Headers 和电子邮件本身中,但我不知道如何将其拖出并将其存储到变量中以供使用 .

如果有人可以帮助我,我将非常感激 .

感谢您的时间 .

肿块吗?有人能提供帮助吗?

1 回答

  • 0

    试试这个...

    Sub LaunchURL(itm As MailItem)
    
        Dim bodyString As String
        Dim bodyStringSplitLine
        Dim bodyStringSplitWord
        Dim splitLine
        Dim splitWord
        Dim myURL As String
        Dim FileDestination As String
    
        bodyString = itm.Body
        FileDestination = "\\sever\folder\report\"
        bodyStringSplitLine = Split(bodyString, vbCrLf)
    
        For Each splitLine In bodyStringSplitLine
            bodyStringSplitWord = Split(splitLine, " ")
    
            For Each splitWord In bodyStringSplitWord
                If Left(splitWord, 46) = "http://example.text/here/Download.aspx?FileID=" Then
                                myURL = splitWord
    
                                Dim WinHttpReq As Object
                                Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
                                WinHttpReq.Open "GET", myURL, False
                                WinHttpReq.Send
    
                                myURL = WinHttpReq.ResponseBody
                                If WinHttpReq.Status = 200 Then
                                    Set oStream = CreateObject("ADODB.Stream")
                                    oStream.Open
                                    oStream.Type = 1
                                    oStream.Write WinHttpReq.ResponseBody
                                    oStream.SaveToFile (FileDestination)
                                    oStream.Close
                                End If
    
                End If
            Next
    
        Next
    
        Set itm = Nothing
    
    End Sub
    
    Private Sub test()
        Dim currItem As MailItem
        Set currItem = ActiveInspector.CurrentItem
        LaunchURL currItem
    End Sub
    

    我得到的唯一问题是压制pop ..但我需要帮助保存文件...我不知道如何编码来捕获url中的文件名 .

相关问题