Wrong String parameter when sending a json string as a post request - apache

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

Related

Invalid_request Missing grant Type VBA Error Oauth 2.0

I'm struggling with this from last some hours.
I'm trying to receive an access token from the API of a partner via OAuth.
There's a small mistake in it that generates this error:
"error":"invalid_request","error_description":"Missing grant type"
Here is the VBA code I'm using in MS Access:
Public Function API_MyArrow_Artikel(artikelBez) As String
Dim objHTTP As Object
Dim strHead As String, strClientId As String, strClientSecret As String, strBody As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
strClientId = "xxx"
strClientSecret = "xxx"
strUrl1 = "https://my.arrow.com/api/security/oauth/token"
strHead = strClientId & ":" & strClientSecret
lngADRNR = 674
objHTTP.Open "POST", strUrl1, False
objHTTP.SetRequestHeader "application", "x-www-form-urlencoded"
objHTTP.SetRequestHeader "client_id", strClientId
objHTTP.SetRequestHeader "client_secret", strClientSecret
objHTTP.SetRequestHeader "Authorization", "Basic " + Base64Encode(strHead)
'objHTTP.setRequestHeader "grant_type", "client_credentials"
objHTTP.SetTimeouts 10000, 10000, 10000, 10000 'Timeout (in milliseconds) to wait for timeout in each request phase (Resolve, Connect, Send, Receive)
objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.Send "grant_type=client_credentials"
API_MyArrow_Artikel = objHTTP.responseText
End Function
Any sort of suggestion to resolve is really appreciated as there are only some experts of OAuth 2.0 in here.
Thanks,
I found a solution to this.
There is some error in URL which needs to be fixed by adding below code to URL:
my.arrow.com/api/security/oauth/token?grant_type=client_credentials
And secondly replacing this:
objHTTP.SetRequestHeader "application", "x-www-form-urlencoded"
To this:
objHTTP.SetRequestHeader "content-type","application/x-www-form-urlencoded"
did the Job for me.

.Write objHTTP.responseBody runtime error 3001

I have some problem with this vba code. This work from over the year. After last execution i get error in ".Write objHTTP.responseBody --runtime error 3001" I try figure out solution but I don't have any ideas. The code login in on page and download 4 files.
This is POST information:
Answers headers (250 B)
Connection
Keep-Alive
Content-Disposition
attachement; filename="baza.csv";
Content-Type
application/csv
Date
Tue, 17 Jul 2018 13:58:32 GMT
Keep-Alive
timeout=5, max=300
Server
Apache/2.4.25
Transfer-Encoding
chunked
Request Headers (976 B)
Accept
text/html,application/xhtml+xm…plication/xml;q=0.9,*/*;q=0.8
Accept-Encoding
gzip, deflate, br
Accept-Language
pl,en-US;q=0.7,en;q=0.3
Connection
keep-alive
Content-Length 38
Content-Type
application/x-www-form-urlencoded
Cookie _pk_id.50.777d=00d79034e23a5b6…41fc349c56e551787285709412976
DNT 1
Host listarobinsonow.pl
Referer https://listarobinsonow.pl/userpanel/base
Upgrade-Insecure-Requests 1
User-Agent Mozilla/5.0 (Windows NT 10.0; …) Gecko/20100101 Firefox/61.0
Code:
Sub SMB_DownloadAll()
Dim destfolder As String
destfolder = ActiveWorkbook.Path
' Autoryzacja
' Dim objHTTP As New WinHttp.WinHttpRequest
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "http://www.listarobinsonow.pl/auth/login"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.send ("identity=xxxxxx&password=xxxxxxx")
objHTTP.WaitForResponse
' pobranie 4 plików
SMB_Download objHTTP, "post", destfolder
SMB_Download objHTTP, "mail", destfolder
SMB_Download objHTTP, "tele", destfolder
SMB_Download objHTTP, "smss", destfolder
ThisWorkbook.Save
End Sub
Sub SMB_Download(ByRef objHTTP, base_type As String, destfolder As String)
URL = "http://www.listarobinsonow.pl/userpanel/base"
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.send ("base_type=" + base_type + "&form_type=base_download")
objHTTP.WaitForResponse
' Dim oStream1 As New ADODB.Stream
Set oStream1 = CreateObject("ADODB.Stream")
With oStream1
.Type = 1
.Open
.Write objHTTP.responseBody - the place where i get error run time 3001
.SaveToFile destfolder + "\" + base_type + ".csv", 2
End With
End Sub

Amazon URL scraping with XMLHTTP - Amazon blocking?

So if I use my browser to browse to a list of a product's ellers, for example:
https://www.amazon.co.uk/gp/offer-listing/B076C6769Z/ref=dp_olp_new?ie=UTF8&condition=new
I see a list of sellers.
BUT if I construct the same URL with VBA utilising XMLHTTP, Amazon returns a different page (generic page not related to the product). it's as if they've sussed that I'm not a person using a browser?
Dim XMLHTTP As Object, html As Object, objResult As Object
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
url = "https://www.amazon.co.uk/gp/offer-listing/B002AVVO7K/ref=dp_olp_new?
ie=UTF8&condition=new"
XMLHTTP.Open "GET", url, False
XMLHTTP.setRequestHeader "Content-Type", "text/xml"
XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0)
Gecko/20100101 Firefox/25.0"
XMLHTTP.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = XMLHTTP.responseText
Debug.Print XMLHTTP.responseText

VBA Loop thru Multiple URLs and Running HTML Requests

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

converting unicode emotion characters while parsing from api result (excel macro)

After I have parsed API results in Excel, I have trouble with unicode characters. There are lots of emoticons like smilies and hearts etc.
They appear like \ud83d\ude09\ud83d\ude09\ud83d\ude09\ud83d\ude09, but I want them to display like this: 😉😉😉😉
'this is my code
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.Open "Get", URL, False
objHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send
''objHTTP.Response.contentType = "text/xml"
strResult = objHTTP.ResponseText
strResult = Replace(strResult, "\u0026", "&", 1)
strResult = Replace(strResult, "\u011f", "ğ", 1)
strResult = Replace(strResult, "\u011e", "Ğ", 1)