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
Related
I would like to run my VBA macro on a specific internet explorer page that I have already opened and logged into .
This is because I have to login to my account and bypass the captcha code first.
I have to send this extremely repetitive message to over a couple hundred people over the course of the year.
Problem with the following is that I am opening up a brand new page and I wont be able to bypass the captcha.
Dim IE As InternetExplorer
Set IE = CreateObject("InternetExplorer.Application")
IE.navigate ("website")
IE.Visible = True
End Sub
Solution
Sub TestGetIE()
Dim IE As Object
'GetIE runs the Functoin we have created below
Set IE = GetIE("website opened in IE here ")
WaitFor IE
end sub
Function GetIE(sLocation As String) As Object
Dim objShell As Object, objShellWindows As Object, o As Object
Dim sURL As String
Dim retVal As Object
Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
For Each o In objShellWindows
'Loop through all the opened internet explorer pages
sURL = ""
'Loops through all the pages opened on internet explorer
'Then we will tell our macro to work on that page
sURL = o.LocationURL
If sURL Like sLocation & "*" Then
Set retVal = o
Exit For
End If
Next o
Set GetIE = retVal
End Function
From your description, I understand that you want user interaction to fill the captcha and then want to continue to automate the same page.
I suggest you for both steps try to use 2 different modules and use the same IE object in both modules.
You can create a global IE object which you can use in both modules.
Then for the login part execute the first module.
After that user will fill the captcha manually.
Then execute the second module to automate the rest of the page.
Sample code:
Public ie As Object
Sub login()
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True
ie.navigate "Your_web_site_URL_here..."
Do While ie.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
ie.document.getElementById("uname").Value = "user1"
ie.document.getElementById("pswd").Value = "12345"
End Sub
Sub second_part()
ie.document.getElementById("email").Value = "user1#abc.com"
ie.document.getElementById("age").Value = "30"
End Sub
UserForm1 code:
Private Sub CommandButton1_Click()
Call Module1.login
End Sub
Private Sub CommandButton2_Click()
Call Module1.second_part
End Sub
Output:
Calling upon this function helped me solve it.
Function GetIE(sLocation As String) As Object
Dim objShell As Object, objShellWindows As Object, o As Object
Dim sURL As String
Dim retVal As Object
Set retVal = Nothing
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
For Each o In objShellWindows
'Loop through all the opened internet explorer pages
sURL = ""
'Loops through all the pages opened on internet explorer
'Then we will tell our macro to work on that page
sURL = o.LocationURL
If sURL Like sLocation & "*" Then
Set retVal = o
Exit For
End If
Next o
Set GetIE = retVal
End Function
One thing you could do is DoEvents until a certain Element is present on the page. Run your code to navigate to the website, then Do Until Element after captcha is present DoEvents. The code will loop until you are on logged into the website. I like using VBA SeleniumBasic ChromeDriver on GetHub. It makes web scraping way easier, and you do not need to use Internet Explorer.
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?
Working on a html reader for a webpage, the problem is: The webpage got a loading screen. Any way to do this without using Internet Explorer application ?.
While IE.Busy
DoEvents
Wend
Do Until IE.statusText = "Done"
DoEvents
Loop
Do Until IE.readyState = 4
DoEvents
Loop
I would perfer to use something like this reader.
Function GetHTML(URL As String) As String
Dim HTML As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
GetHTML = .responseText
End With
End Function
Any ideas or leads will be most appreciated.
I have the following function which returns HTML document for the URL passed. I am using the returned HTML Doc in some other function.
The function works perfectly on Windows 7 but NOT on windows 8 unfortunately. How can I write code which works on Windows 7 and 8 both? I think I need to use a different version of XML HTTP object.
Function GetHtmlDoc(ByVal URL As String) As Object
Dim msg As String
' Reset the Global variables.
PageSrc = ""
Set htmlDoc = Nothing
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, True
.Send
While .readyState <> 4: DoEvents: Wend
a = .statusText
' Check for any server errors.
If .statusText <> "OK" Then
' Check for WinHTTP error.
'msg = GetWinHttpErrorMsg(.Status)
'If msg = "" Then msg = .statusText
' Return the error number and message.
GetPageSource = "ERROR: " & .Status & " - " & msg
Exit Function
End If
' Save the HTML code in the Global variable.
PageSrc = .responseText
End With
' Create an empty HTML Document.
Set htmlDoc = CreateObject("htmlfile")
htmlDoc.Open URL:="text/html", Replace:=False
' Convert the HTML code into an HTML Document Object.
htmlDoc.write PageSrc
' Terminate Input-Output with the Global variable.
htmlDoc.Close
' Return the HTML text of the web page.
Set GetHtmlDoc = htmlDoc
End Function
Example function call:
Set htmlDoc = GetHtmlDoc("http://www.censusdata.abs.gov.au/census_services/getproduct/census/2011/quickstat/POA2155?opendocument&navpos=220")
XMLHTTP no longer likes accessing remote servers from local scripts, switch to ServerXMLHTTP:
With CreateObject("MSXML2.ServerXMLHTTP")
.Open "GET", URL, False
(Using False performs the operation synchronously ngating the need for the readyState loop.)
I had same error turns out my code was working fine, just firewall blocked Excel so it failed.
i have a problem with fetching data from an internal web based Dataservice (cognos).
Basically i put together a GET request like "blah.com/cognosapi.dll?product=xxx&date=yyy...", send it to the server and receive a webpage that i can store as HTML and parse into my excel form later.
I build a VBA program which worked quite well in the past, but the webservice changed an now they are displaying a "your report is running" page in between that lasts from 1sec to 30sec. So when i call my function i always download this "your report is running" page insteat of the data. How can i catch the page that automatically loads up after the "report is running" page?
This is the DownloadFile Function with the GETstring and the target path as parameters.
Public Function DownloadFile(sSourceUrl As String, _
sLocalFile As String) As Boolean
Dim HttpReq As Object
Set HttpReq = CreateObject("MSXML2.XMLHTTP")
Dim HtmlDoc As New MSHTML.HTMLDocument
HttpReq.Open "GET", sSourceUrl, False
HttpReq.send
If HttpReq.Status = 200 Then
HttpReq.getAllResponseHeaders
HtmlDoc.body.innerHTML = HttpReq.responseText
Debug.Print HtmlDoc.body.innerHTML
End If
'Download the file. BINDF_GETNEWESTVERSION forces
'the API to download from the specified source.
'Passing 0& as dwReserved causes the locally-cached
'copy to be downloaded, if available. If the API
'returns ERROR_SUCCESS (0), DownloadFile returns True.
DownloadFile = URLDownloadToFile(0&, _
sSourceUrl, _
sLocalFile, _
BINDF_GETNEWESTVERSION, _
0&) = ERROR_SUCCESS
End Function
Thanks
David
finally you gave me the final link to solve my problem. I baked the code into my DownloadFile Function to stay with the IE Object until the end and then close it.
One Error i found is was that the readystate should be polled before anything is done with the HTMLObject.
Public Function DownloadFile(sSourceUrl As String, _
sLocalFile As String) As Boolean
Dim IE As InternetExplorer
Set IE = New InternetExplorer
Dim HtmlDoc As New MSHTML.HTMLDocument
Dim collTables As MSHTML.IHTMLElementCollection
Dim collSpans As MSHTML.IHTMLElementCollection
Dim objSpanElem As MSHTML.IHTMLSpanElement
Dim fnum As Integer
With IE
'May changed to "false if you don't want to see browser window"
.Visible = True
.Navigate (sSourceUrl)
'this waits for the page to be loaded
Do Until .readyState = 4: DoEvents: Loop
End With
'Set HtmlDoc = wait_for_html(sSourceUrl, "text/css")
Do
Set HtmlDoc = IE.Document
'searching for the "Span" tag
Set collSpans = HtmlDoc.getElementsByTagName("span")
'first Span element cotains...
Set objSpanElem = collSpans(0)
'... this if loading screen is display
Loop Until Not objSpanElem.innerHTML = "Your report is running."
'just grab the tables and leave the rest
Set collTables = HtmlDoc.getElementsByTagName("table")
fnum = FreeFile()
Open sLocalFile For Output As fnum ' save the file and add html and body tags
Print #fnum, "<html>"
Print #fnum, "<body>"
Print #fnum, collTables(15).outerHTML 'title
Print #fnum, collTables(17).outerHTML 'Date
Print #fnum, collTables(18).outerHTML 'Part, Operation etc.
Print #fnum, collTables(19).outerHTML 'Measuerements
Print #fnum, "</body>"
Print #fnum, "</html>"
Close #fnum
IE.Quit 'close Explorer
DownloadFile = True
End Function
Since you're using a GET request, I'm assuming any required parameters can be provided in the URL string. In that case, you might be able to use InternetExplorer.Application, which should automatically update its Document property whenever the page refreshes. You could then set up a loop which periodically checks for some value (tag text, URL, etc...) that's unique to the desired page.
Here's a sample which loads a URL, then waits until the page's <title> tag is the desired value.
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function wait_for_html(strURL as String, strDesiredText as String) as String
Dim IE As InternetExplorer
Set IE = New InternetExplorer
IE.Navigate (strURL)
While IE.ReadyState <> 4
Sleep 10
Wend
Dim objHtml As MSHTML.HTMLDocument
Dim collTitle As MSHTML.IHTMLElementCollection
Dim objTitleElem As MSHTML.IHTMLTitleElement
Do
Sleep 1000
Set objHtml = IE.Document
Set collTitle = objHtml.getElementsByTagName("title")
Set objTitleElem = collTitle(0)
Loop Until objTitleElem.Text = strDesiredText
wait_for_html = objHtml.body.innerHTML
End Function
The above needs references to Microsoft Internet Controls and Microsoft HTML Object Library.