为 Outlook 转换 Excel 'Download PDF file from webpage' 代码

Convert Excel 'Download PDF file from webpage' code for Outlook

下面的 Excel 代码旨在转到网页,搜索超链接并下载 PDF 文件并保存在桌面上。

我需要为 Outlook 修改它:

  1. 以便它检测发件人电子邮件,例如通用@gmail.com
  2. 检测电子邮件和网页中的超链接以检测按钮 'Export Details' 并按下它
  3. 然后在下一页按 'Export' 按钮并在桌面上保存 CVS 文件:“C:\Users\mlad1406\Desktop\Test”。
Sub DownPDF()
' This macro downloads the pdf file from webpage
' Need to download MSXML2 and MSHTML parsers and install

Dim sUrl As String
Dim xHttp As MSXML2.XMLHTTP
Dim hDoc As MSHTML.HTMLDocument
Dim hAnchor As MSHTML.HTMLAnchorElement
Dim Ret As Long
Dim sPath As String
Dim i As Long

sPath = "C:\Users\mlad1406\Desktop\Test"
sUrl = "https://copernicus.my.salesforce.com/00O20000006WD95"

'Get the directory listing
Set xHttp = New MSXML2.XMLHTTP
xHttp.Open "GET", sUrl
xHttp.Send

'Wait for the page to load
Do Until xHttp.readyState = 4
    DoEvents
Loop

'Put the page in an HTML document
Set hDoc = New MSHTML.HTMLDocument
hDoc.Body.innerHTML = xHttp.responseText

'Loop through the hyperlinks on the directory listing
For i = 0 To hDoc.getElementsByTagName("a").Length - 1
    Set hAnchor = hDoc.getElementsByTagName("a").Item(i)

    'test the pathname to see if it matches your pattern
    If hAnchor.PathName Like "Ordin-*.2013.pdf" Then
        Ret = UrlDownloadToFile(0, sUrl & hAnchor.PathName, sPath, 0, 0)

        If Ret = 0 Then
            Debug.Print sUrl & hAnchor.PathName & " downloaded to " & sPath
        Else
            Debug.Print sUrl & hAnchor.PathName & " not downloaded"
        End If
    End If
Next i

End Sub

这是一些代码,应该可以帮助您开始(如果您确实在邮件中查找发件人地址):

您要查找的字段是:oMailItem.SenderEmailAddress

Sub Extract_Body_Subject_From_Mails()

Dim oNS As Outlook.NameSpace
Dim oFld As Outlook.Folder
Dim oMails As Outlook.Items
Dim oMailItem As Outlook.MailItem
Dim oProp As Outlook.PropertyPage

Dim sSubject As String
Dim sBody

'On Error GoTo Err_OL

Set oNS = Application.GetNamespace("MAPI")
Set oFld = oNS.GetDefaultFolder(olFolderInbox)
Set oMails = oFld.Items

For Each oMailItem In oMails
    MsgBox oMailItem.SenderEmailAddress
        'MsgBox oMails.Count    'oMails.Item(omails.Find(
        sBody = oMailItem.Body
        sSubject = oMailItem.Subject
        'MsgBox sSubject
        MsgBox sBody      
Next

Exit Sub
Err_OL:
If Err <> 0 Then
    MsgBox Err.Number & " - " & Err.Description
    Err.Clear
Resume Next
End If
End Sub









'First create a rule that looks at the subject of incoming messages and fires when it sees "A new incident". Have the rule run a script. I called mine "Check_For_Ticket" in this example. See the pic of my rule attached.
Sub Check_For_Ticket(MyMail As MailItem)
    On Error GoTo Proc_Error

    Dim strTicket, strSubject As String

    ' Default value in case # is not found in the subject line
    strTicket = "None"

    ' Grab the subject from the message
    strSubject = MyMail.Subject

    ' See if it has a hash symbol in it
    If InStr(1, strSubject, "#") > 0 Then

        ' Trim off leading stuff up to and including the hash symbol
        strSubject = Mid(strSubject, InStr(strSubject, "#") + 1)

        ' Now find the trailing space after the ticket number and chop it off after that
        If InStr(strSubject, " ") > 0 Then
            strTicket = Left(strSubject, InStr(strSubject, " ") - 1)
        End If
    End If
    MsgBox "Your Ticket # is: " & strTicket

Proc_Done:
    Exit Sub

Proc_Error:
    MsgBox "An error has occured in Check_For_Ticket. Error #" & Err & " - " & Err.Description
    GoTo Proc_Done
End Sub
'Of course, you would substitute whatever processing you want where the messagebox shows the ticket number.