Question

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

我需要为Outlook修改它：

以便它检测到发件人电子邮件，即generic@gmail.com
检测电子邮件和网页上的超链接，以检测按钮“导出详细信息”并按下
然后在下一页按“导出”按钮并在桌面上保存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

Answer 1

以下是一些代码，可以帮助您启动（如果您查看邮件以查找发件人地址）：

您要查找的字段是：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.

转换Excel VBA代码以将PDF文件从网页下载到Outlook VBA代码

1 个答案: