Related
I am working on xmlHTTP request to extract JSON data from the web.
The below is my code.
Public Sub testlibor2()
Dim JSON As Object
Dim ws As Worksheet, results(), i As Long, s As String
Dim BL As String
Dim mypara As String
Dim mydest As String
Dim URL, URL1, URL2, URL3 As String
URL1 = "draw=1&columns%5B0%5D%5Bdata%5D=0&columns%5B0%5D%5Bname%5D=wdt_ID&columns%5B0%5D%5Bsearchable%5D=true&columns%5B0%5D%5Borderable%5D=true&columns%5B0%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B0%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B1%5D%5Bdata%5D=1&columns%5B1%5D%5Bname%5D=date&columns%5B1%5D%5Bsearchable%5D=true&columns%5B1%5D%5Borderable%5D=true&columns%5B1%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B1%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B2%5D%5Bdata%5D=2&columns%5B2%5D%5Bname%5D=weekday&columns%5B2%5D%5Bsearchable%5D=true&columns%5B2%5D%"
URL2 = "5Borderable%5D=true&columns%5B2%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B2%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B3%5D%5Bdata%5D=3&columns%5B3%5D%5Bname%5D=o&columns%5B3%5D%5Bsearchable%5D=true&columns%5B3%5D%5Borderable%5D=true&columns%5B3%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B3%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B4%5D%5Bdata%5D=4&columns%5B4%5D%5Bname%5D=wdt_column&columns%5B4%5D%5Bsearchable%5D=true&columns%5B4%5D%5Borderable%5D=true&columns%5B4%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B4%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B5%5D%5Bdata%5D=5&columns%5B5%5D%5Bname%5D=wdt_column_1&columns%5B5%5D%5Bsearchable%5D=true&columns%5B5%5D%5Borderable%5D=true&columns%5B5%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B5%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B6%5D%5Bdata%5D=6&columns%5B6%5D%5Bname%5D=1m&columns%5B6%5D%5Bsearchable%"
URL3 = "5D=true&columns%5B6%5D%5Borderable%5D=true&columns%5B6%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B6%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B7%5D%5Bdata%5D=7&columns%5B7%5D%5Bname%5D=wdt_column_2&columns%5B7%5D%5Bsearchable%5D=true&columns%5B7%5D%5Borderable%5D=true&columns%5B7%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B7%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B8%5D%5Bdata%5D=8&columns%5B8%5D%5Bname%5D=3m&columns%5B8%5D%5Bsearchable%5D=true&columns%5B8%5D%5Borderable%5D=true&columns%5B8%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B8%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B9%5D%5Bdata%5D=9&columns%5B9%5D%5Bname%5D=wdt_column_3&columns%5B9%5D%5Bsearchable%5D=true&columns%5B9%5D%5Borderable%5D=true&columns%5B9%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B9%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B10%5D%5Bdata%5D=10&columns%"
URL4 = "5B10%5D%5Bname%5D=wdt_column_4&columns%5B10%5D%5Bsearchable%5D=true&columns%5B10%5D%5Borderable%5D=true&columns%5B10%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B10%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B11%5D%5Bdata%5D=11&columns%5B11%5D%5Bname%5D=6m&columns%5B11%5D%5Bsearchable%5D=true&columns%5B11%5D%5Borderable%5D=true&columns%5B11%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B11%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B12%5D%5Bdata%5D=12&columns%5B12%5D%5Bname%5D=wdt_column_5&columns%5B12%5D%5Bsearchable%5D=true&columns%5B12%5D%5Borderable%5D=true&columns%5B12%5D%5Bsearch%5D%5Bvalue%5D=&columns%5B12%5D%5Bsearch%5D%5Bregex%5D=false&columns%5B13%5D%5Bdata%5D=13&columns%5B13%5D%5Bname%5D=wdt_column_6&columns%5B13%5D%5Bsearchable%5D=true&columns%5B13%5D%5Borderable%5D=true&columns%5B13%5D%5Bsearch%5D%5Bvalue%5D=&column"
mypara = URL1 & URL2 & URL3 & URL4
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://iborate.com/wp-admin/admin-ajax.php?action=get_wdtable&table_id=12", False
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.88 Safari/537.36"
.send mypara
Debug.Print .responseText
Set JSON = JsonConverter.ParseJson(.responseText)
End With
End Sub
The code above does not work at all. I cannot receive any JSON data from this.
I have adjusted all the request Headers based on the details from the Chrome dev Tools, and I have
absolutely no Idea what the issue is.
The original URL is as below. I am trying to access the table in the web.
http://iborate.com/usd-libor/
Thank you!
One additional question. Are there any alternatives to dealing with URL strings that are too long to be contained inside one variable? I divided the string as below but I am not sure if this is the best way to handle it.
UPDATE
Based on #QHarr's idea I have changed the Form data into a JSON string. However the code still does not work.
Public Sub testlibor2()
Dim JSON As Object
Dim ws As Worksheet, results(), i As Long, s As String
Dim shipvalue As String, custom As String, MyURL As String
Dim BL As String
Dim mypara, newpara As String
Dim URL, URL1, URL2, URL3, URL4, URL5 As String
URL1 = "{""draw"":""2"",""columns[0][data]"":""0"",""columns[0][name]"":""wdt_ID"",""columns[0][searchable]"":""true"",""columns[0][orderable]"":""true"",""columns[0][search][value]"":"""",""columns[0][search][regex]"": ""false"",""columns[1][data]"": ""1"",""columns[1][name]"": ""date"",""columns[1][searchable]"": ""true"",""columns[1][orderable]"": ""true"",""columns[1][search][value]"": ""|"",""columns[1][search][regex]"": ""false"",""columns[2][data]"": ""2"",""columns[2][name]"": ""weekday"",""columns[2][searchable]"": ""true"",""columns[2][orderable]"":""true"",""columns[2][search][value]"": """","
URL2 = """columns[2][search][regex]"":""false"",""columns[3][data]"":""3"",""columns[3][name]"": ""o"",""columns[3][searchable]"": ""true"",""columns[3][orderable]"": ""true"",""columns[3][search][value]"": """",""columns[3][search][regex]"": ""false"",""columns[4][data]"": ""4"",""columns[4][name]"": ""wdt_column"",""columns[4][searchable]"": ""true"",""columns[4][orderable]"": ""true"",""columns[4][search][value]"": """",""columns[4][search][regex]"": ""false"",""columns[5][data]"": ""5"",""columns[5][name]"": ""wdt_column_1"",""columns[5][searchable]"": ""true"",""columns[5][orderable]"": ""true"",""columns[5][search][value]"": """",""columns[5][search][regex]"": ""false"",""columns[6][data]"": ""6"",""columns[6][name]"": ""1m"",""columns[6][searchable]"": ""true"",""columns[6][orderable]"": ""true"",""columns[6][search][value]"": """",""columns[6][search][regex]"": ""false"",""columns[7][data]"": ""7"",""columns[7][name]"": ""wdt_column_2"",""columns[7][searchable]"": ""true"","
URL3 = """columns[7][orderable]"": ""true"",""columns[7][search][value]"": """",""columns[7][search][regex]"": ""false"",""columns[8][data]"": ""8"",""columns[8][name]"": ""3m"",""columns[8][searchable]"": ""true"",""columns[8][orderable]"": ""true"",""columns[8][search][value]"": """",""columns[8][search][regex]"": ""false"",""columns[9][data]"": ""9"",""columns[9][name]"": ""wdt_column_3"",""columns[9][searchable]"": ""true"",""columns[9][orderable]"": ""true"",""columns[9][search][value]"": """",""columns[9][search][regex]"": ""false"",""columns[10][data]"": ""10"",""columns[10][name]"": ""wdt_column_4"",""columns[10][searchable]"": ""true"",""columns[10][orderable]"": ""true"",""columns[10][search][value]"": """",""columns[10][search][regex]"": ""false"",""columns[11][data]"": ""11"",""columns[11][name]"": ""6m"",""columns[11][searchable]"": ""true"",""columns[11][orderable]"": ""true"",""columns[11][search][value]"": """",""columns[11][search][regex]"": ""false"","
URL4 = """columns[12][data]"": ""12"",""columns[12][name]"": ""wdt_column_5"",""columns[12][searchable]"": ""true"",""columns[12][orderable]"": ""true"",""columns[12][search][value]"": """",""columns[12][search][regex]"": ""false"",""columns[13][data]"": ""13"",""columns[13][name]"": ""wdt_column_6"",""columns[13][searchable]"": ""true"",""columns[13][orderable]"": ""true"",""columns[13][search][value]"": """",""columns[13][search][regex]"": ""false"",""columns[14][data]"": ""14"",""columns[14][name]"": ""wdt_column_7"",""columns[14][searchable]"": ""true"",""columns[14][orderable]"": ""true"",""columns[14][search][value]"": """",""columns[14][search][regex]"": ""false"",""columns[15][data]"": ""15"",""columns[15][name]"": ""wdt_column_8"",""columns[15][searchable]"": ""true"",""columns[15][orderable]"": ""true"",""columns[15][search][value]"": """",""columns[15][search][regex]"": ""false"",""columns[16][data]"": ""16"",""columns[16][name]"": ""wdt_column_9"",""columns[16][searchable]"": ""true"","
URL5 = """columns[16][orderable]"": ""true"",""columns[16][search][value]"": """",""columns[16][search][regex]"": ""false"",""columns[17][data]"": ""17"",""columns[17][name]"": ""12m"",""columns[17][searchable]"": ""true"",""columns[17][orderable]"": ""true"",""columns[17][search][value]"": """",""columns[17][search][regex]"": ""false"",""order[0][column]"": ""1"",""order[0][dir]"": ""desc"",""start"": ""0"",""length"": ""10"",""search[value]"": """",""search[regex]"": ""false"",""wdtNonce"": ""ce62a523fa"",""sRangeSeparator"": ""|""}"
mypara = URL1 & URL2 & URL3 & URL4 & URL5
newpara = Replace(mypara, " ", "")
Debug.Print newpara
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://iborate.com/wp-admin/admin-ajax.php?action=get_wdtable&table_id=12", False
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.88 Safari/537.36"
.setRequestHeader "Accept-Encoding", "gzip, deflate"
.send newpara
Debug.Print .responseText
Set JSON = JsonConverter.ParseJson(.responseText)
End With
End Sub
I have checked couple of times to make sure the JSON string is exactly identical as the one suggested below from QHarr.
Can anyone identify a solution from here?
url = https://www.justdial.com/Bangalore/Internet-Website-Developers/nct-11035713/page-1
Function getPageContent(ByVal url As String) As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.Open "GET", url, False
objHTTP.setRequestHeader "Content-Type", "text/xml"
objHTTP.setRequestHeader "Cache-Control", "no-cache"
objHTTP.setRequestHeader "Pragma", "no-cache"
objHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/84.0.4147.135 Safari/537.36"
objHTTP.send
If objHTTP.Status = 200 Then
getPageContent = objHTTP.responseText
End If
End Function
I am trying to extract justdial webpage but I am not getting the response, Instead i am getting 504 time out error. see my code for any corrections. I am getting response on postman
Please, adapt the function in this way (it needs MSXML2.XMLHTTP60). It needs a reference to 'Microsoft XML, v6.0' - (In VBE - Tools - References, scroll down, check it when found and press 'OK') :
Function getPageContent(ByVal url As String) As String
'It needs reference to 'Microsoft XML, v6.0'
Dim objHTTP As New MSXML2.XMLHTTP60
With objHTTP
.Open "GET", url, False
.setRequestHeader "Content-Type", "text/xml"
.setRequestHeader "Cache-Control", "no-cache"
.setRequestHeader "Pragma", "no-cache"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/84.0.4147.135 Safari/537.36"
.send
If .status = 200 Then
getPageContent = .responseText
End If
End With
End Function
Tested it in the next way:
Sub testExtractPage()
Dim url As String
url = "https://www.justdial.com/Bangalore/Internet-Website-Developers/nct-11035713/page-1"
Debug.Print getPageContent(url)'See the result in Immediate Window (Ctrl + G, in VBE)
End Sub
I've written a macro in vba to get a "name" from a website using POST request. To reach the target page it is necessary to send POST request twice. Firstly, a page opens up like the first image underneath. After clicking on the "search by address" button on the starting page it leads to another page where two boxes to be filled in which is shown in the image 2 below. One for street number and the other for street name. After clicking on the search button when the form is done filling then it leads to the target page with the information i'm after. I tested it using msgbox in the script to be sure i'm on the right page. I'm surely on that page and i can see the title of that page which is "HARRIS COUNTY APPRAISAL DISTRICT". However, I can't parse anything from that page. I'm after this name "LARA PEDRO A & MARIA G" from that page.
This is the macro I'm trying with:
Sub httpPost()
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim rec As HTMLHtmlElement
Dim ArgStr As String, ArgStr_ano As String
ArgStr = "search=addr"
ArgStr_ano = "TaxYear=2017&stnum=15535&stname=CAMPDEN+HILL+RD"
With http
.Open "POST", "https://public.hcad.org/records/QuickSearch.asp", False
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
.setRequestHeader "Referer", "https://public.hcad.org/records/quicksearch.asp"
.send ArgStr
End With
With http
.Open "POST", "https://public.hcad.org/records/QuickRecord.asp", False
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
.setRequestHeader "Referer", "https://public.hcad.org/records/quicksearch.asp"
.send ArgStr_ano
html.body.innerHTML = .responseText
End With
MsgBox http.responseText
End Sub
Search to be made with:
Street No: 15535
Street Name: CAMPDEN HILL RD
These are the image of two pages following which target page can be reached:
"https://www.dropbox.com/s/e9on9zwqzmcboze/1Untitled.jpg?dl=0"
"https://www.dropbox.com/s/0lchpde8uq63jps/pics.jpg?dl=0"
I somehow caught the url using chrome developer tool and using that url in my below code I get the result I'm after. However, what's wrong with my "POST" request? Why can't I get the same using the above method? For your consideration, here is another bit of code to get the result using the collected url from chrome dev tool what i got by sending post request twice as i did in my above code:
Sub Web_Data()
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim post As Object
With http
.Open "GET", "https://public.hcad.org/records/details.asp?crypt=%94%9A%B0%94%BFg%85%8D%83%82og%8El%87tXvXQJXJzDTpHjEyr%D4%BE%C2%AF%AE%AA%9Fpk%88%5Do%5B%B8%96%A3%C0q%5E&bld=1&tab=", False
.send
html.body.innerHTML = .responseText
End With
For Each post In html.getElementsByClassName("data")(2).getElementsByTagName("th")
i = i + 1: Cells(i, 1) = post.innerText
Next post
End Sub
The result is:
LARA PEDRO A & MARIA G
15531 CAMPDEN HILL RD
HOUSTON TX 77053-3302
Finally solved it myself. Here is the working code:
Sub httpPost()
Dim http As New WinHttp.WinHttpRequest, html As New HTMLDocument
Dim post As Object
Dim ArgStr As String, ArgStr_ano As String
ArgStr = "search=addr"
ArgStr_ano = "TaxYear=2017&stnum=15535&stname=CAMPDEN+HILL+RD"
With http
.Option(6) = True
.Open "POST", "https://public.hcad.org/records/QuickSearch.asp", False
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
.setRequestHeader "Referer", "https://public.hcad.org/records/quicksearch.asp"
.send ArgStr
End With
With http
.Option(6) = True
.Open "POST", "https://public.hcad.org/records/QuickRecord.asp", False
.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/60.0.3112.90 Safari/537.36"
.setRequestHeader "Referer", "https://public.hcad.org/records/quicksearch.asp"
.send ArgStr_ano
html.body.innerHTML = .responseText
End With
For Each post In html.getElementsByClassName("data")(2).getElementsByTagName("th")
i = i + 1: Cells(i, 1) = post.innerText
Next post
End Sub
I'm going to have multiple instrument numbers and URLs to run this code through. The instrument numbers will start in Column B from Row 8 and down. This VBA currently only runs instrument number 19930074944. How can I have it loop through all these instrument numbers and skip blank cells?
searchResultsURL = baseURL & "GetRecDataDetail.aspx?rec=19930074944&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5="
So I need to edit it so that it's:
searchResultsURL = baseURL & "GetRecDataDetail.aspx?rec= & InstNum & "&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5="
Then InstNum has to reference B8 and down. And run all this code on each different URL. I have no idea how to do that. Thanks so much!
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
Something like this:
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
Edit your original code to include a parameter (relevant parts shown only)
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
Hi The below code should work for you..Looping through all the elements..
Note: change sheet1 to required sheet.Pls mark as answer.
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
I used this code for my Macro in VBA in excel:
Sub Macro1()
Dim URL As String, JSONString As String, objHTTP As Object
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "xxxxx"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
JSONString = "{""name"": ""long"",""startDate"": 12345,""endDate"": 67890,""status"": ""in progress""}"
objHTTP.send JSONString
Debug.Print objHTTP.Status
Debug.Print objHTTP.responseText
End Sub
In the immediate window, I received this error:
400 Apache Tomcat/8.0.28 - Error
reportH1
{font-family:Tahoma,Arial,sans-serif;color:white;background-color:#525D76;font-size:22px;}
H2
{font-family:Tahoma,Arial,sans-serif;color:white;background-color:#525D76;font-size:16px;}
H3
{font-family:Tahoma,Arial,sans-serif;color:white;background-color:#525D76;font-size:14px;}
BODY
{font-family:Tahoma,Arial,sans-serif;color:black;background-color:white;}
B
{font-family:Tahoma,Arial,sans-serif;color:white;background-color:#525D76;} P
{font-family:Tahoma,Arial,sans-serif;background:white;color:black;font-size:12px;}A
{color : black;}A.name {color : black;}.line {height: 1px;
background-color: #525D76; border: none;}
HTTP Status 400 - Required String parameter 'name' is
not presenttype Status
reportmessage Required String parameter 'name' is not
presentdescription The request sent by the client
was syntactica lly incorrect.Apache
Tomcat/8.0.28
I have not known how to solve it, please help me !
I solved this problem:
Sub Macro1()
Dim URL As String, JSONString As String, objHTTP As Object
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "xxxxx?name=long&startDate=12345&endDate=67890&status=in progress"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send
Debug.Print objHTTP.Status
Debug.Print objHTTP.responseText
End Sub