Data Scraping using VBA From website doesn’t download - vba

I am trying to download some data from website which starts download upon clicking.
But this code is not working, Can anyone help.
Dim ie As InternetExplorer
Dim htmldoc As MSHTML.IHTMLDocument
Dim HTMLInput As MSHTML.IHTMLElementCollection
Dim HTMLAs As MSHTML.IHTMLElementCollection
Dim HTMLA As MSHTML.IHTMLElement
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
'Navigate to webpage
Dim ieURL As String: ieURL = "http://erldc.org/final-schedule.aspx"
ie.navigate ieURL
Do While ie.readyState <> READYSTATE_COMPLETE
Loop
Set htmldoc = ie.document
Set HTMLInput = htmldoc.getElementsByTagName("a")
For Each HTMLA In HTMLAs
Debug.Print HTMLA.getAttribute("classname"), HTMLA.getAttribute("href"), HTMLA.getAttribute("rel")
If HTMLA.getAttribute("href") = "javascript:__doPostBack('ctl00$ContentPlaceHolder1$Calendar1','6420')" Then
HTMLA.Click
Exit For
End If
Next HTMLA
End Sub

Try pausing the macro for a few seconds, maybe 5 seconds, after the Do While/Loop that checks for the ReadyState...
Dim sngFinish As Single
Dim intPauseTime As Integer
intPauseTime = 5 'in seconds
sngFinish = timer + intPauseTime
Do While timer < sngFinish
DoEvents
Loop
Also, I would suggest that you check the Busy state of Internet Explorer, in addition to the ReadyState, and add DoEvents...
Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Hope this helps!

Related

Type Mismatch on one machine

I wrote some code to scrape data from a website. I've tested it on 5 difference machines with different versions of excel and it all works fine. But on the intended users machine we get type mismatch error.The code fails at the last line below.
Sub LogIn()
Dim ie As SHDocVw.InternetExplorer
Dim iDoc As MSHTML.HTMLDocument
Dim ele As MSHTML.IHTMLElement
Dim eles As MSHTML.IHTMLElementCollection
Dim tableSection As MSHTML.IHTMLElement
Dim tableRow As MSHTML.IHTMLElement
Dim tableCell As MSHTML.IHTMLElement
Dim smallCell As MSHTML.IHTMLElement
Dim iCol As Integer
Dim iRow As Integer
Dim iCounter As Integer
iRow = 0
Do
iRow = iRow + 1
Loop Until Cells(iRow, 5) = ""
Range(Cells(1, 5), Cells(iRow, 6)).ClearContents
Set ie = New InternetExplorer
ie.Visible = False
ie.navigate ("https://www.howdidido.com/")
Do While ie.readyState <> READYSTATE_COMPLETE
Loop
Set iDoc = ie.document
any help greatly appreciated.
I have tried the following code and it is working alright. Maybe it can help you (seems as two loops and doEvents are needed for the ready state completes).
Dim iDoc As MSHTML.HTMLDocument
Dim iCol As Integer
Dim iRow As Integer
Dim iCounter As Integer
Dim i As Long
Dim URL As String
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
Set IE = CreateObject("InternetExplorer.Application")
'Set IE.Visible = True to make IE visible, or False for IE to run in the background
IE.Visible = True
'Define URL
URL = "https://www.automateexcel.com/excel/"
'Navigate to URL
IE.Navigate URL
' Statusbar let's user know website is loading
Application.StatusBar = URL & " is loading. Please wait..."
' Wait while IE loading...
'IE ReadyState = 4 signifies the webpage has loaded (the first loop is set to avoid inadvertently skipping over the second loop)
Do While IE.ReadyState = 4: DoEvents: Loop 'Do While
Do Until IE.ReadyState = 4: DoEvents: Loop 'Do Until
'Webpage Loaded
Application.StatusBar = URL & " Loaded"
Set iDoc = IE.Document
'Unload IE
Set IE = Nothing
Set objElement = Nothing
Set objCollection = Nothing

The data in A "id" is not printing

i am trying this
Sub JJ()
Dim IE As New SHDocVw.InternetExplorer
Dim hdoc As MSHTML.HTMLDocument
Dim ha As String
IE.Visible = True
IE.navigate "https://www.nseindia.com/get-quotes/equity?symbol=DIVISLAB"
Do While IE.readyState <> READYSTATE_COMPLETE
Loop
Set hdoc = IE.document
ha = hdoc.getElementById("preOpenFp").innerText
Debug.Print ha
End Sub
Please suggest any solution for that.
the point is in image.
If you want to read the data from the Pre-Open Markt you have to change the url as follows https://www.nseindia.com/get-quotes/equity?symbol=DIVISLAB#info-preopenmkt.Try this code.
Sub JJ()
Dim IE
Set IE = CreateObject("InternetExplorer.Application")
'Dim IE As New SHDocVw.InternetExplorer
Dim hdoc As MSHTML.HTMLDocument
Dim ha As String
IE.Visible = True
IE.navigate "https://www.nseindia.com/get-quotes/equity?symbol=DIVISLAB#info-preopenmkt"
Do While IE.Busy: DoEvents: Loop
Do While IE.Busy And Not IE.readyState = READYSTATE_COMPLETE: DoEvents: Loop
'Application.Wait (Now + TimeValue("0:00:15"))
Set hdoc = IE.document
ha = hdoc.getElementById("preOpenIep").innerText
Debug.Print (ha)
End Sub

Upload a file into html browser using VBA

I am trying to upload a file to a web page, the following are the steps I followed:
Open the web page http://www.htmlquick.com/reference/tags/input-file.html
Wait for until the page is getting loaded
In this webpage I am uploading the file into the first “Upload a File” browser.
Get the input element by tag name as “input”
Hit the “browse” button, since the paste potion is disabled.
Enter the file path in the “Choose File to Upload” window
Enter
After 5th step, I am not able to enter the file path in the “Choose File to Upload” window, looks like the macro is not supporting for this.
Here is my code :
Sub File_Test()
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLButtons As MSHTML.IHTMLElementCollection
Dim HTMLButton As MSHTML.IHTMLElement
Dim ie As Object
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True
ie.navigate "http://www.htmlquick.com/reference/tags/input-file.html"
Do While ie.readyState <> READYSTATE_COMPLETE
Loop
Set HTMLDoc = ie.document
Set HTMLButtons = HTMLDoc.getElementsByTagName("input")
For Each HTMLButton In HTMLButtons
If HTMLButton.Type = "file" Then
HTMLButton.Click
HTMLButton.Value = "C:\Documents\Test\Temp.txt"
Exit For
End If
Next
End Sub
And here's a screenshot:
Any suggestions?
===================================================
Here is another modified code but sill I am not able to enter the file name
Sub File_Test()
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLButtons As MSHTML.IHTMLElementCollection
Dim HTMLButton As MSHTML.IHTMLElement
Dim ie As Object
Dim WSshell
Set WSshell = CreateObject("WScript.Shell")
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True
ie.navigate "http://www.htmlquick.com/reference/tags/input-file.html"
Do While ie.readyState <> READYSTATE_COMPLETE
Loop
Set HTMLDoc = ie.document
Set HTMLButtons = HTMLDoc.getElementsByTagName("input")
For Each HTMLButton In HTMLButtons
If HTMLButton.Type = "file" Then
HTMLButton.Click
With WSshell
Application.Wait (Now + TimeValue("0:00:10"))
.AppActivate "Choose File to Upload"
Application.Wait (Now + TimeValue("0:00:10"))
.SendKeys "C:\Documents\Test\Temp.txt"
Application.Wait (Now + TimeValue("0:00:10"))
.SendKeys "~" 'Enter
End With
Exit For
End If
Next
End Sub
Any idea? why sendkyes are not working?

How to scrape data from newly opening webpage?

To scrape data from webpage which is opening after clicking a submit button
In this website I'm filling textbox showing place-holder #Tracking with this value 148459 after filling clicking Submit it opens another page, with details... I want to scrape the data on that page and bring it into Excel using VBA.
My guess is that the Submit button is using POST method; I need help to scrape the webpage with POST method.
I've worked out with below code:
Dim IE As New SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLInput As MSHTML.IHTMLElement
Dim HTMLButton As MSHTML.IHTMLElement
Dim HTMLButtons As MSHTML.IHTMLElementCollection
Dim HTMLAs As MSHTML.IHTMLElementCollection
Dim HTMLA As MSHTML.IHTMLElement
Dim txt As String
Dim delStat As String
txt = ActiveCell.Value
IE.Visible = True
'IE.Navigate "http://206.50.6.194/WebtrakWT/shipinquiry/quicktrack.aspx"
IE.Navigate "http://206.50.6.194/WebtrakWT/shipinquiry/ShipInfo.aspx?OrderNo=393874&Back=QuickTrack&TrackType=HousebillNo&TrackNo=" & txt
Do While IE.ReadyState <> READYSTATE_COMPLETE
Loop
Set HTMLDoc = IE.Document
'Set HTMLInput = HTMLDoc.getElementById("ddlTrackBy")
'HTMLInput.Value = "HousebillNo"
'Set HTMLInput = HTMLDoc.getElementById("txtInputNo")
'HTMLInput.Value = ActiveCell.Value
'Do While IE.ReadyState <> READYSTATE_COMPLETE
' DoEvents
' Loop
'Set HTMLButton = HTMLDoc.getElementById("btnSubmit")
'HTMLButton.Click
Do While IE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set HTMLAs = HTMLDoc.getElementsByTagName("span")
For Each HTMLA In HTMLAs
Debug.Print HTMLA.getAttribute("id"), HTMLA.innerHTML
Next HTMLA
delStat = HTMLDoc.getElementById("lblStatus").innerHTML
Debug.Print delStat
If delStat = "DELIVERED" Then
ActiveCell.Offset(0, 5).Value = "Delivered"
Call screenShot
Else
ActiveCell.Offset(0, 5).Value = "Not Delivered"
End If
IE.Quit
Set IE = Nothing

How to automatically fill value in a box in webpage using via excel

This is not for the first time I am mentioning this...but yeah I am a rookie in vba and in need of help...
I am having trouble in filling up a value in a box in webpage using vba excel.
The source code of the box is
<input
name="MultiRenameTable_OR:wt.epm.EPMDocument:3053059700_NEWNAME_JSID"
class="enabledfield"
id="MultiRenameTable_OR:wt.epm.EPMDocument:3053059700_NEWNAME_JSID"
style="WIDTH:98% onblur="setJSAttributeValue(this,'NEWNAME_JSID','MultiRenameTable', 'epmdoc_09876889_u46_drw',undefined)" type="text" size="25" ?=""
trlId="MultiRenameTable_epmdoc_09876889_u46_drw_NEWNAME_JSID"></input>
the code i wrote is
Sub xx()
Dim ie As Object
Dim doc As HTMLDocument
Dim lo As IHTMLElementCollection
Dim l As IHTMLElement
Set ie = CreateObject("internetexplorer.application")
ie.navigate "mysiteurl"
ie.Visible = True
Do While ie.Busy: DoEvents: Loop
Do While ie.readyState <> 4: DoEvents: Loop
Set doc = ie.document
doc.getElementById("MultiRenameTable_OR:wt.epm.EPMDocument3053059700_NEWNAME_JSID").Value = "xyz"
End Sub
It doesnt set the value.
Also i cannot use "name","ID","trlID","onblur" because they keep on changing each time i launch IE.
Please help me with this.
I'm guessing from the setJSAttributeValue that the name will always contain the substring "NEWNAME_JSID". Just grab all of the input elements, then loop through them looking for it in the name:
Sub xx()
Dim ie As Object
Dim doc As HTMLDocument
Dim lo As IHTMLElementCollection
Dim l As IHTMLElement
Set ie = CreateObject("internetexplorer.application")
ie.navigate "mysiteurl"
ie.Visible = True
Do While ie.Busy: DoEvents: Loop
Do While ie.readyState <> 4: DoEvents: Loop
Set doc = ie.document
Set lo = doc.getElementsByTagName("input")
For Each l In lo
If l.Name Like "*NEWNAME_JSID*" Then
'Do whatever.
Exit For
End If
Next l
End Sub