MSXML2.ServerXMLHTTP send exits method - vba

I have a report in access that gets an image from a url when charged, for this purpose I use MSXML2.ServerXMLHTTP to get the url.
Here is the code used:
Dim sURL As String
Dim v As Variant
v = Split(sURL, "/")(UBound(Split(sURL, "/")))
Dim obj As Object
Dim fl() As Byte
Set obj = CreateObject("MSXML2.ServerXMLHTTP")
With obj
.Open "GET", sURL, False
.Send
fl = .Responsebody
End With
The problem I have is when in the execution arrives to the .send it exits from the method despite having some more code, giving me no errors but also not displaying the image in the report.
Do you know what may be the cause?
Thank you in advance.

Related

Extract Data from URL VBA

I am trying to get Addresses Data from URL but facing some error. I am just beginner in VBA, i did not Understand where is problem in my code. wish somebody can help me to get right solution.
here I attached Image and also my VBA code
here is my Code
Public Sub IE_GetLink()
Dim sResponse As String, HTML As HTMLDocument
Dim url As String
Dim Re As Object
Set HTML = New HTMLDocument
Set Re = CreateObject("MSXML2.XMLHTTP")
'On Error Resume Next
url = "http://markexpress.co.in/network1.aspx?Center=360370&Tmp=1656224682265"
With Re
.Open "GET", url, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
sResponse = StrConv(.responseBody, vbUnicode)
End With
Dim Title As Object
With HTML
.body.innerHTML = sResponse
Title = .querySelectorAll("#colspan")(0).innerText
End With
MsgBox Title
End Sub
Please help me ...
Several things.
What is wrong with your code:
Title should be a string as you are attempting to assign the return of .innerText to it. You have declared it as an object which would require SET keyword (and the removal of the .innerText accessor).
Colspan is an attribute not an id so your css selector list is incorrect.
Furthermore, looking at what the page actually does, there is a request for an additional document which actually has the info you need. You need to take the centre ID you already have and change the URI you make a request to.
Then, you want only the first td in the target table. Change your CSS selector list to target that.
Public Sub GetInfo()
Dim HTML As MSHTML.HTMLDocument
Dim re As Object
Set HTML = New MSHTML.HTMLDocument
Set re = CreateObject("MSXML2.XMLHTTP")
Dim url As String
Dim response As String
url = "http://crm.markerp.in/NetworkDetail.aspx?Center=360370&Tmp="
With re
.Open "GET", url, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
response = .responseText
End With
Dim info As String
With HTML
.body.innerHTML = response
info = .querySelector("#tblDisp td").innerText
End With
MsgBox info
End Sub

How to get the authorization code value from the redirect URI in VBA using XMLHTTP60 object?

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

How to test whether WinHttpRequest works or if corporate security issue causes error

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

VERY strange behavior on createobject("HTMLFILE")!

I don't understand why I'm getting this strange behavior!
When creating and assigning the htmlfile object the function gives back a blank object ("nothing") and when I am running the code line by line it just runs automatically even when I don't press F8 to run the next line...
It gives no error whatsoever!
Any ideas as to what might be happening?
Line where the strange behavior starts: Set htmlObj = CreateObject("HTMLFILE")
Public Function XMLHTTP_Request(Method As String, URL As String, Optional PostData As String, Optional StrCookie As String) As HTMLDocument
Dim oXMLHTTP As Object, htmlObj as object
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open Method, URL, False
oXMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oXMLHTTP.setRequestHeader "Cookies", StrCookie
On Error GoTo ErrorHandler
oXMLHTTP.send (PostData)
On Error GoTo 0
While oXMLHTTP.ReadyState <> 4: DoEvents: Wend
While oXMLHTTP.Status <> 200: DoEvents: Wend
Set htmlObj = CreateObject("HTMLFILE")
htmlObj.body.innerHTML = oXMLHTTP.responseText
Set XMLHTTP_Request = htmlObj
End Function
Repeated calls to the function will cause multiple calls to the CreateObject function. The oXMLHTTP and htmlObj object vars could be made static or library references could be included and the variable declaration changed to Early Binding.
Early binding requires that the following non-default library references are added through the VBE's Tools ► References command.
Microsoft HTML Object Library
Microsoft Internet Controls
Microsoft XML 6.0 (your own version may vary slightly).
Module1 code sheet:
Option Explicit
Sub main()
Debug.Print Left(XMLHTTP_Request("http//example.com").body.innerText, 512)
End Sub
Public Function XMLHTTP_Request(URL As String, _
Optional Method As String = "POST", _
Optional PostData As String = "", _
Optional StrCookie As String = "") As HTMLDocument
Dim oXMLHTTP As New MSXML2.XMLHTTP60
Dim htmlObj As New HTMLDocument
oXMLHTTP.Open Method, URL, False
oXMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
oXMLHTTP.setRequestHeader "Cookies", StrCookie
oXMLHTTP.send PostData
If oXMLHTTP.Status <> 200 Then Exit Function
htmlObj.body.innerHTML = oXMLHTTP.responseText
Set XMLHTTP_Request = htmlObj
End Function
Running the main() sub procedure will output the first 512 characters of the web page's text to the Immediate window ([Ctrl]+G).

http response text fetching incomplete html

I have a code (given below) in excel vba that fetches web page source html. The code is working fine but the html that it fetches is incomplete. When the line webpageSource = oHttp.ResponseText is executed, the variable webpageSource contains "DOCTYPE html PUBLIC ....... etc etc till the end /html" and that is how it should be. Everything is correct till here. But the next line debug.print webpageSource prints only half the html from "(adsbygoogle = window.adsbygoogle || []).push({}); ...... etc etc till the end /html" Why is that so? I want to find some strings from the returned response text but since it is incomplete, I am unable to do so. Can someone shed some light on it?
Thanks
Sub source()
Dim oHttp As New WinHttp.WinHttpRequest
Dim sURL As String
Dim webpageSource As String
sURL = "http://www.somewebsite.com"
oHttp.Open "GET", sURL, False
oHttp.send
webpageSource = oHttp.ResponseText
debug.print webpageSource
End Sub
EDIT:
I also tried .WaitForResponse with no help :(
Debug.Print and/or the immediate window have limitations. Nowhere documented however they have.
So try writing the webpageSource to a file:
Sub source()
Dim oHttp As New WinHttp.WinHttpRequest
Dim sURL As String
Dim webpageSource As String
sURL = "http://www.google.com"
oHttp.Open "GET", sURL, False
oHttp.send
webpageSource = oHttp.ResponseText
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFile = FSO.CreateTextFile("webpageSource.txt")
oFile.Write webpageSource
oFile.Close
Shell "cmd /C start webpageSource.txt"
End Sub
Does the file contain all content?