http response text fetching incomplete html - vba

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?

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

MSXML2.ServerXMLHTTP send exits method

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.

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).

html file save restore from vba

I want to re-use a snapshot of a web response for testing an app that needs to do some web-scraping. What I tried to do is just save the response (from Chrome) and reload the the string from the file:
doc.body.innerHtml = StringFromFile
This doesn't work though, although it looks like good html. By not work, I mean data that is in tag "Table"(6) when going through the web is not found. Is there a better way to load the html doc?
The code below is an attempt to both save an existing doc to file and then reuse it. Its worthless but maybe it will help someone set me straight on this.
Cheers
Private Function GetEWhipersTestHtmlDoc() As HTMLDocument
Dim doc As HTMLDocument
Set doc = New HTMLDocument
Dim sText As String
sText = GetStringFromFile(GetFileName("UnconfirmedRelease"))
doc.body.innerHTML = sText
Set GetEWhipersTestHtmlDoc = doc
End Function
Private Function GetFileName(testName As String) As String
GetFileName = ThisWorkbook.path & Application.PathSeparator & _
"Earnings Whispers Test Scenarios" & Application.PathSeparator & testName & ".txt"
Debug.Assert Dir(GetFileName) <> ""
End Function
Private Function SaveHtmlStringToFile(testName As String, sInnerHtml As String) As String
Dim fso As Object
Dim oFile As Object
Dim sPath As String
Set fso = CreateObject("Scripting.FileSystemObject")
sPath = GetFileName(testName)
Set oFile = fso.CreateTextFile(sPath)
oFile.WriteLine sInnerHtml
oFile.Close
End Function
** UPDATE **
Saving doc.body.outerHtml seems to be an upgrade from what I had. The text can turned into the web page using 'code snippet'. I am getting an error when trying to put the saved text back into a new document though:
Err 600, Application-defined or object-defined error
Private Function GetEWhipersTestHtmlDoc() As HTMLDocument
Dim doc As New HTMLDocument
Dim sText As String
' Error Handling
On Error GoTo ErrHandler
sText = GetStringFromFile(GetFileName("UnconfirmedRelease"))
doc.body.outerHTML = sText <---- ** ERROR is Here
Set GetEWhipersTestHtmlDoc = doc
Exit Function
ErrHandler:
Select Case DspErrMsg("blah")
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Function
final update
thanks to Tim and David I got something usable. The only hair of Tim's final solution is that HtmlDocument.Write is restricted as far as VBA is concerned. So to 'fool' the compiler, I needed to declare it as an Object:
Dim doc As Object <--- don't let vba know we want to write to HTMLDoc
Set doc = New HTMLDocument
Dim sText As String
sText = GetStringFromFile(GetFileName("UnconfirmedRelease"))
doc.Open
doc.Write sText <-- no intellisense, but compiles...and works!
doc.Close

Open Source Code in Chrome with VBA

I've got this so far. Only the Chrome browser opens (which is empty) & it doesn't take into consideration the url. What changes should I make to the Shell script?
Sub ViewSource()
Dim chromePath As String
chromePath = """C:\Program Files\Google\Chrome\Application\chrome.exe"""
Shell (chromePath & "view-source:http://search.yahoo.com/search;_ylt=A0oGdXgbd8FQJXoAuj6l87UF?p=cars%20parts&fr=sfp&pqstr=car%20parts")
End Sub
Thanks!
I have tried many different flags on Chrome.exe in cmd prompt but non are working.
But you can get the source code this way:
Sub t()
GetSource "http://search.yahoo.com/search;_ylt=A0oGdXgbd8FQJXoAuj6l87UF?p=cars%20parts&fr=sfp&pqstr=car%20parts"
End Sub
Function GetSource(url As String) As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url
.Send
Do: DoEvents: Loop Until .Readystate = 4
GetSource = .responsetext
.abort
End With