展望VBA代碼

Question

我是新的宏，可以真正使用一些幫助。下面的代碼來自Excel，用於訪問網頁，搜索超鏈接並下載PDF文件並將其保存在桌面上。

我需要修改它的展望：

1. 因此，它檢測到發件人地址，即generic@gmail.com
2. 檢測在電子郵件和網頁上的超鏈接來檢測按鈕「導出詳細信息「並按下它
3. 然後在下一頁按下」導出「按鈕並在桌面上保存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.