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请求

回答

相关问题