We have an internal website, which supports working with API also. When i access an API URI in browser i'm getting JSON response, but if i make the same call from Excel i'm getting 401, invalid credentials. Please find my VBA Code below.
Dim Serv2 As New WinHttpRequest
Sub Conn()
Url = "https://uri/api/nag/"
With Serv2
.Open "GET", Url, False
.Send
MsgBox .Status & " " & .ResponseText
End With
Set Serv2 = Nothing
End Sub
Note: The url provided is sample data.
Many Thanks in advance !!!
Related
I need some help to download the stock table located in this URL:
I’ve tried with the code below to at least grab the first line, but what in the inspector is showed as :
<a target=”_blank”href=”/equities/apple-computer-inc” title=Apple Inc”>Apple</a>
I can only see:
A title={fullName} href="about:{pairLink}" target=_blank>{pairName}
This is the code I've put together:
Sub table()
Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim Tables As MSHTML.IHTMLElementCollection
Dim table As MSHTML.IHTMLElement
Dim TableRow As MSHTML.IHTMLElement
XMLReq.Open "GET", "https://es.investing.com/stock-screener/?sp=country::5|sector::a|industry::a|equityType::a|exchange::a|eq_market_cap::110630000,1990000000000%3Ceq_market_cap;2", False
XMLReq.send
If XMLReq.Status <> 200 Then
MsgBox "problem" & vbNewLine & XMLReq.Status & "- " & XMLReq.statusText
Exit Sub
End If
HTMLDoc.body.innerHTML = XMLReq.responseText
Set Tables = HTMLDoc.getElementsByTagName("Table")
For Each table In Tables
If table.className = "displayNone genTbl openTbl resultsStockScreenerTbl elpTbl " Then
For Each TableRow In table.getElementsByTagName("td")
Debug.Print TableRow.innerHTML
Next
End If
Next table
End Sub
Any help will be appreciated.
It looks like the actual data that fills the table is pulled from JSON from another request that some javascript or something runs on the page.
This might make it easier to parse the response with a json parser but it might be difficult to compose the correct request to get the data you want. The owners of the website might not want you do do this so they might not make it easy.
It looks like a POST request with a bunch of parameters and also a cookie sent along. So basically you would need to re-create this POST request by adding all of the correct parameters and the correct cookie in the header. I would get a web debugging program like fiddler (shown above) to look and see what is going on.
I was going to also suggest you check and see if that website provides an API but it looks like it doesn't?
EDIT:
I was actually able to get the JSON with the data you want by pretty much just copying the request used on the site:
Sub getdata()
Dim XMLReq As New MSXML2.XMLHTTP60
XMLReq.Open "POST", "https://es.investing.com/stock-screener/Service/SearchStocks", False
XMLReq.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
XMLReq.setRequestHeader "Accept", "application/json"
XMLReq.setRequestHeader "X-Requested-With", "XMLHttpRequest"
XMLReq.send "country%5B%5D=5&exchange%5B%5D=95&exchange%5B%5D=2&exchange%5B%5D=1§or=5%2C12%2C3%2C8%2C9%2C1%2C7%2C6%2C2%2C11%2C4%2C10&industry=74%2C56%2C73%2C29%2C25%2C4%2C47%2C12%2C8%2C44%2C52%2C45%2C71%2C99%2C65%2C70%2C98%2C40%2C39%2C42%2C92%2C101%2C6%2C30%2C59%2C77%2C100%2C9%2C50%2C46%2C88%2C94%2C62%2C75%2C14%2C51%2C93%2C96%2C34%2C55%2C57%2C76%2C66%2C5%2C3%2C41%2C87%2C67%2C85%2C16%2C90%2C53%2C32%2C27%2C48%2C24%2C20%2C54%2C33%2C19%2C95%2C18%2C22%2C60%2C17%2C11%2C35%2C31%2C43%2C97%2C81%2C69%2C102%2C72%2C36%2C78%2C10%2C86%2C7%2C21%2C2%2C13%2C84%2C1%2C23%2C79%2C58%2C49%2C38%2C89%2C63%2C64%2C80%2C37%2C28%2C82%2C91%2C61%2C26%2C15%2C83%2C68&equityType=ORD%2CDRC%2CPreferred%2CUnit%2CClosedEnd%2CREIT%2CELKS%2COpenEnd%2CRight%2CParticipationShare%2CCapitalSecurity%2CPerpetualCapitalSecurity%2CGuaranteeCertificate%2CIGC%2CWarrant%2CSeniorNote%2CDebenture%2CETF%2CADR%2CETC%2CETN&eq_market_cap%5Bmin%5D=110630000&eq_market_cap%5Bmax%5D=1990000000000&pn=1&order%5Bcol%5D=eq_market_cap&order%5Bdir%5D=d"
If XMLReq.Status <> 200 Then
MsgBox "problem" & vbNewLine & XMLReq.Status & "- " & XMLReq.statusText
Exit Sub
End If
Debug.Print XMLReq.responseText
End Sub
So now you will just need to figure out how to parse the JSON response.
I am trying to get the authorization code from my VBA macro as given here,
https://learn.microsoft.com/en-us/onedrive/developer/rest-api/getting-started/graph-oauth?view=odsp-graph-online
While I know a web page URL will get the code appended, I am not sure how to get the code value from the redirect Uri in a VBA object in those while I have set the redirect uri for mobile and desktop applications as suggested - "https://login.microsoftonline.com/common/oauth2/nativeclient" for the registered client in azure.
Below is the code,
Dim WinHttpReq As XMLHTTP60
Set WinHttpReq = New XMLHTTP60
myURL="https://login.microsoftonline.com/<MyTenantID>/oauth2/v2.0/authorize?client_id={MyClientID}&response_type=code&redirect_uri={https://login.microsoftonline.com/common/oauth2/nativeclient}&response_mode=query&scope=https://graph.microsoft.com/.default"
WinHttpReq.Open "POST", myURL
WinHttpReq.send
Debug.Print WinHttpReq.responseText
'Debug.Print WinHttpReq.responseBody
The above code returns some HTML and javascript as the response but not the Authorization code value.
I am trying to follow this - msGraph API from msAccess VBA - Planner plans credentials issue - but it looks like the redirect uri is pointing to web page to get the auth code.
How can I get it in my VBA WinHttpReq object?
I tried this (which works if you pass a redirecting bit.ly URL to it) but for OAuth, since the status returns 200 and not 301, the OAuth flow doesn't seem to look like a redirect as far as the HTTP object is concerned:
With WinHttpReq
.Open "POST", myURL
.Option(6) = True ' 6=WinHttpRequestOption_EnableRedirects
.Send
Debug.Print .Option(1) ' 1=WinHttpRequestOption_URL
Debug.Print .GetResponseHeader("Location")
End With
But this does work:
Function GetAuthCodeIE(myURL As String) As String
Const READYSTATE_COMPLETE As Long = 4
Dim oIE As Object
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Navigate myURL
' Wait for response
While oIE.Busy Or oIE.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Dim Response As String
Response = oIE.LocationURL
Dim aResponse() As String
aResponse = Split(Response, "?")
aResponse = Split(aResponse(1), "&")
GetAuthCodeIE = Replace(aResponse(0), "code=", "")
End Function
I found the following code on an excel forum:
Function URLExists(url As String) As Boolean
Dim Request As Object
Dim ff As Integer
Dim rc As Variant
On Error GoTo EndNow
Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")
With Request
.Open "GET", url, False
.Send
rc = .StatusText
End With
Set Request = Nothing
If rc = "OK" Then URLExists = True
Exit Function
EndNow:
End Function
I see no reason why it would not work if I use a legitiamte URL. I have been testing it and keep on getting a FALSE returned. Opening the same URL in a browser works.
I suspect that this might have something to do with our coporate security settings. How can I test whether the code works or if it is a security issue?
The function goes to the error line on .Send
I've written some code in vba to find certain identities against some names in some websites. The code is working well if everything in it's right order, i meant if the link is valid, the name matches with a tags and finally the regex can find the identity. If any of the three or all of the three are bad searches then the script throws error. I've already specified the position where error occurs in my below script.
All i expect from you experts to provide me with any solution as to how i can handle the errors and let my script continue until all the links are exhausted.
As I do not have much knowledge on VBA so i tried with On error resume next to skip the errors. However, it turns out to be a clear mess when i take a look at the results. I'm pasting a rough example what i get when i use On error resume next.
Sub Identity_Finder()
Dim http As New XMLHTTP60, html As New HTMLDocument
Dim post As Object, link As Variant, refined_links As String
Dim rxp As New RegExp, identity As Object
For Each link In [{"http://spltech.in/","http://www.unifrostindia.com/","http://www.unitfrostindia.com/","http://www.greenplanet.in/"}]
With http
.Open "GET", link, False
.send '''throws here the first error if the link is invalid
html.body.innerHTML = .responseText
End With
For Each post In html.getElementsByTagName("a")
If InStr(post.innerText, "certain_name") > 0 Then refined_links = post.href: Exit For
Next post
With http
.Open "GET", refined_links, False
.send ''throws another error here if no such link is found
End With
With rxp
.Pattern = "some_regex"
.Global = True
Set identity = .Execute(http.responseText)
End With
r = r + 1: Cells(r, 1) = link
Cells(r, 2) = identity(0) ''''throws another error here if no such identity is noticed
Next link
End Sub
Upon using On error resume next What i get:
John executive
Mac lawyer
lulu lawyer
Robin lawyer
Cathy student
Expected output:
John executive
Mac lawyer
lulu
Robin
Cathy student
The empty fields (when they are not found) are getting filled in with the previous values when i use On error resume next. How can I get around this misleading result? Thanks in advance.
The most efficient way to error trap in VBA is to
1) actually test the inputs / results before running them either through custom-made functions or built-in coding concepts or a mix of both.
2) Use VBA built-in error-handling if absolutely needed
Example 1
For example. You can wrap this statement with a custom function to test if a URL is valid or not.
With http
.Open "GET", link, False
.send '''throws here the first error if the link is invalid
html.body.innerHTML = .responseText
End With
If ValidURL Then
With http
.Open "GET", link, False
.send
html.body.innerHTML = .responseText
End With
End If
Where ValidURL is a function defined as:
Function ValidURL(URL as String) as Boolean
Dim result as Boolean
'I don't know how you would specify a valid link in your specific case
'but that code goes here
'a dummy example follows
result = Left(URL,7) = "http://"
ValidURL = result 'True or False
End Function
Example 2
I assume in this statement:
With http
.Open "GET", refined_links, False
.send ''throws another error here if no such link is found
End With
there is a specific error number (code) that is produced when no such link is found. Discover that number and use this code to bypass.
With http
.Open "GET", refined_links, False
On Error Resume Next
.Send
On Error GoTo 0
End With
If err.Number <> 9999 'replace with correct number
'continue with regex test
End If
PUTTING IT ALL TOGETHER
Finally putting that all together you can build like so, with minimal use of On Error Resume Next and no GoTo statements.
For Each link In [{"http://spltech.in/","http://www.unifrostindia.com/","http://www.unitfrostindia.com/","http://www.greenplanet.in/"}]
If ValidURL(link) Then
With http
.Open "GET", link, False
.send
html.body.innerHTML = .responseText
End With
For Each post In html.getElementsByTagName("a")
If InStr(post.innerText, "certain_name") > 0 Then refined_links = post.href: Exit For
Next post
With http
.Open "GET", refined_links, False
On Error Resume Next
.Send
On Error GoTo 0
End With
If err.Number <> 9999 'replace with correct number
With rxp
.Pattern = "some_regex"
.Global = True
Set identity = .Execute(http.responseText)
End With
'i will leave it to you on how to account for no pattern match
r = r + 1: Cells(r, 1) = link
Cells(r, 2) = identity(0) ''''throws another error here if no such identity is noticed
End If
End If
Next link
The VBA code below is supposed to call a REST API to grant user access to the file or not. If the REST API returns allow then the code should close normally and grant access, if the REST API retuns disallow then the program should notify user and close workbook. If there is no Internet access, then the user should be notified and the work book should be closed.
My question is how do I code so the REST API response is handled by the macro properly so that it will either end normally or close due to the disallow response from url?
Here is the VBA code so far:
Private Sub Workbook_activate()
Application.EnableCancelKey = xlDisabled
' Run the Error handler "ErrHandler" when an error occurs.
On Error GoTo Errhandler
ActiveWorkbook.FollowHyperlink Address:="https://mysite.com/licensing/getstatus.php?", NewWindow:=True
' If response is allow
' Exit the macro so that the error handler is not executed.
****what goes here??****
Exit Sub
' If response is disallow
****what goes here??****
MsgBox "Your license key is not valid. Please check your key or contact customer service."
ActiveWorkbook.Close SaveChanges:=False
Errhandler:
' If no Internet Access, display a message and end the macro.
MsgBox "An error has occurred. You need Internet access to open the software."
ActiveWorkbook.Close SaveChanges:=False
End Sub
here an example for a simple HttpWebRequest:
Dim oRequest As Object
Set oRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
oRequest.Open "GET", "https://mysite.com/licensing/getstatus.php?"
oRequest.Send
MsgBox oRequest.ResponseText
If you are behind a proxy you can use something like this:
Const HTTPREQUEST_PROXYSETTING_PROXY = 2
Dim oRequest As Object
Set oRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
oRequest.setProxy HTTPREQUEST_PROXYSETTING_PROXY, "http://proxy.intern:8080"
oRequest.Open "GET", "https://mysite.com/licensing/getstatus.php?"
oRequest.Send
MsgBox oRequest.ResponseText
and if you want to use POST (instead of the GET method) to pass some values to the webserver, you can try this:
Dim oRequest As Object
Set oRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
oRequest.Open "POST", "https://mysite.com/licensing/getstatus.php"
oRequest.SetRequestHeader "Content-Typ", "application/x-www-form-urlencoded"
oRequest.Send "var1=123&anothervar=test"
MsgBox oRequest.ResponseText