VBA循環通過多個URL和運行HTML請求

我將有多個儀器編號和URL來運行此代碼。儀器編號將從行8的列B開始並向下。此VBA目前僅運行儀器編號19930074944。我怎樣才能讓它遍歷所有這些儀器號碼並跳過空白單元格？VBA循環通過多個URL和運行HTML請求

searchResultsURL = baseURL & "GetRecDataDetail.aspx?rec=19930074944&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5="

所以，我需要讓IT部門編輯：

searchResultsURL = baseURL & "GetRecDataDetail.aspx?rec= & InstNum & "&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5="

然後InstNum必須引用B8和向下。並在每個不同的網址上運行所有這些代碼。我不知道該怎麼做。非常感謝！

Option Explicit 

Public Sub Download_PDF() 

Dim baseURL As String, searchResultsURL As String, pdfURL As String, PDFdownloadURL As String 
Dim httpReq As Object 
Dim HTMLdoc As Object 
Dim PDFlink As Object 
Dim cookie As String 
Dim downloadFolder As String, localFile As String 

Const WinHttpRequestOption_EnableRedirects = 6 

'Folder in which the downloaded file will be saved 

downloadFolder = ThisWorkbook.Path 
If Right(downloadFolder, 1) <> "\" Then downloadFolder = downloadFolder & "\" 

baseURL = "http://recorder.maricopa.gov/recdocdata/" 
searchResultsURL = baseURL & "GetRecDataDetail.aspx?  rec=19930074944&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5=" 

Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1") 

With httpReq 

'Send GET to request search results page 

.Open "GET", searchResultsURL, False 
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0) Gecko/20100101 Firefox/46.0" 
.Send 
cookie = .getResponseHeader("Set-Cookie") 

'Put response in HTMLDocument for parsing 
Set HTMLdoc = CreateObject("HTMLfile") 
HTMLdoc.body.innerHTML = .responseText 

'Get PDF URL from pages link 
'< a id="ctl00_ContentPlaceHolder1_lnkPages" title="Click to view unofficial document" 
' href="unofficialpdfdocs.aspx?rec=19930074944&pg=1&cls=RecorderDocuments&suf=" target="_blank">11< /a> 

Set PDFlink = HTMLdoc.getElementById("ctl00_ContentPlaceHolder1_lnkPages") 
pdfURL = Replace(PDFlink.href, "about:", baseURL) 
'Send GET request to the PDF URL with automatic http redirects disabled.   This returns a http 302 status (Found) with the Location header containing the URL of the PDF file 

.Open "GET", pdfURL, False 
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0) Gecko/20100101 Firefox/46.0" 
.setRequestHeader "Referer", searchResultsURL 
.setRequestHeader "Set-Cookie", cookie 
.Option(WinHttpRequestOption_EnableRedirects) = False 
.Send 
PDFdownloadURL = .getResponseHeader("Location") 

'Send GET to request the PDF file download 

.Open "GET", PDFdownloadURL, False 
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:47.0) Gecko/20100101 Firefox/46.0" 
.setRequestHeader "Referer", pdfURL 
.Send 

End With 
End Sub

來源

2016-11-20 Chris Green

事情是這樣的：

Sub DoAll() 
    Dim c As Range 
    Set c = Activesheet.Range("B8") 
    Do While c.Value<>"" 

     Download_PDF c.Value 

     Set c = c.offset(1,0) 'next value 
    Loop 
End sub

編輯您的原代碼，包括參數（只顯示相關部分）

Public Sub Download_PDF(InsNumber) 
'.... 
'.... 
searchResultsURL = baseURL & "GetRecDataDetail.aspx?rec=" & InsNumber & _ 
     "&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5=" 

'.... 
'.... 
End Sub

來源

2016-11-20 23:50:39

HA560您好，我得到一個請求頭沒有被發現的錯誤？謝謝。 –

你回答了我錯誤的答案，我想 –

Tim，那有效。謝謝你太多了。非常感謝你！ –

嗨下面的代碼應該you..Looping工作通過所有元素。注意：將sheet1更改爲所需的sheet.Pls標記爲答案。

 Option Explicit 

     Public Sub Download_PDF() 

     Dim baseURL As String, searchResultsURL As String, pdfURL As String, PDFdownloadURL As String 
     Dim httpReq As Object 
     Dim HTMLdoc As Object 
     Dim PDFlink As Object 
     Dim cookie As String 
     Dim downloadFolder As String, localFile As String 

     Const WinHttpRequestOption_EnableRedirects = 6 

     'Folder in which the downloaded file will be saved 

     downloadFolder = ThisWorkbook.Path 
     If Right(downloadFolder, 1) <> "\" Then downloadFolder = downloadFolder & "\" 

     baseURL = "http://recorder.maricopa.gov/recdocdata/" 


     Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1") 
     Dim Instnum As String 
     Dim i As Integer 
     For i = 8 To Sheet1.Range("b" & Rows.Count).End(xlUp).Row 

     Instnum = Sheet1.Cells(i, 2).Value 
     searchResultsURL = baseURL & "GetRecDataDetail.aspx?  rec=" & Instnum & "&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5=" 
     With httpReq 

     'Send GET to request search results page 

     .Open "GET", searchResultsURL, False 
     .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0) Gecko/20100101 Firefox/46.0" 
     .Send 
     cookie = .getResponseHeader("Set-Cookie") 

     'Put response in HTMLDocument for parsing 
     Set HTMLdoc = CreateObject("HTMLfile") 
     HTMLdoc.body.innerHTML = .responseText 

     'Get PDF URL from pages link 
     '< a id="ctl00_ContentPlaceHolder1_lnkPages" title="Click to view unofficial document" 
     ' href="unofficialpdfdocs.aspx?rec=19930074944&pg=1&cls=RecorderDocuments&suf=" target="_blank">11< /a> 

     Set PDFlink = HTMLdoc.getElementById("ctl00_ContentPlaceHolder1_lnkPages") 
     pdfURL = Replace(PDFlink.href, "about:", baseURL) 
     'Send GET request to the PDF URL with automatic http redirects disabled.   This returns a http 302 status (Found) with the Location header containing the URL of the PDF file 

     .Open "GET", pdfURL, False 
     .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0) Gecko/20100101 Firefox/46.0" 
     .setRequestHeader "Referer", searchResultsURL 
     .setRequestHeader "Set-Cookie", cookie 
     .Option(WinHttpRequestOption_EnableRedirects) = False 
     .Send 
     PDFdownloadURL = .getResponseHeader("Location") 

     'Send GET to request the PDF file download 

     .Open "GET", PDFdownloadURL, False 
     .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:47.0) Gecko/20100101 Firefox/46.0" 
     .setRequestHeader "Referer", pdfURL 
     .Send 

     End With 
     Next i 
     End Sub

與餅乾= .getResponseHeader（「設置Cookie」）任何想法的第二次迭代

來源

2016-11-20 23:53:00 HA560

VBA循環通過多個URL和運行HTML請求

回答

相關問題