I need to webscrape a website that I actually have to type the keys to show the password form.
I've tried this code with no success (even using the right login)
Sub login()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate ("https://wsvr10.coamo.com.br/npl/#!/login")
While IE.readyState <> READYSTATE_COMPLETE
Wend
sng = Timer
Do While sng + 5 > Timer
Loop
Dim idoc As MSHTML.HTMLDocument
Set idoc = IE.document
idoc.all.cpf.Value = "11111111111"
Related
I need to switch from ie to xmhttp60, and get the result of the execScript. Is there any way to do it? Below the code
I'm using.
Sub MostrarMasButton()
Dim ie As InternetExplorer
Dim CurrentWindow As HTMLWindowProxy
url = "https://es.investing.com/equities/amazon-com-inc-earnings"
Set ie = New InternetExplorer
ie.Visible = True
ie.navigate url
Do While ie.Busy = True Or ie.readyState <> 4: DoEvents: Loop
ie.document.parentWindow.execScript ("showMoreEarningsHistory(6435, this)")
End Sub
I'm very new to work with IE in vba so it is hard for me sometimes to rectify any mistake I make while writing any code to scrape data from web. I've written some code to click on each video links out of 20 links under the caption Microsoft computer training videos available in it's front page. I expect to click each links then navigate back and repeat the process until all the links are clicked. The class names and tag names I've defined in my scraper is accurate. All i need to do is perform the process in the right way. At this moment my scraper is clicking the last link of the 20 links and get stuck there where it reaches but don't navigate back.
This is what I've written so far.
Sub clicking_links()
Const surl As String = "http://www.wiseowl.co.uk/videos/"
Dim IE As New InternetExplorer, iedoc As HTMLDocument
Dim posts As Object
With IE
.Visible = True
.navigate surl
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set iedoc = IE.document
End With
For Each posts In iedoc.getElementsByClassName("woVideoListDefaultSeriesTitle")
posts.getElementsByTagName("a")(0).Click
Next posts
End Sub
Try the following:
Sub clicking_links()
Const surl As String = "http://www.wiseowl.co.uk/videos/"
Dim newurl as String
Dim IE As New InternetExplorer, iedoc As HTMLDocument
Dim posts As Object
Dim t As Long, i As Long
With IE
.Visible = True
.navigate surl
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set iedoc = .document
For Each posts In iedoc.getElementsByClassName("woVideoListDefaultSeriesTitle")
t = t + 1 'count the number of posts
Next posts
For i = 1 To t
Debug.Print i
newurl = iedoc.getElementsByClassName("woVideoListDefaultSeriesTitle")(i - 1).getElementsByTagName("a")(0).href
Debug.Print newurl
.navigate newurl
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set iedoc = .document
'here do your stuff within the new url
.navigate surl 'back to old url
Do Until .readyState = READYSTATE_COMPLETE: Loop
Set iedoc = .document
Next i
End With
End Sub
My code :
Sub login()
Dim IE As Object
Dim HTMLDoc As Object, HTMLDoc2 As Object
Dim objCollection As Object
Const navOpenInNewTab = &H800
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate "https:/com/1/19/login.esp"
Do While IE.Busy Or IE.ReadyState <> 4: Loop
Set HTMLDoc = IE.Document
With HTMLDoc
HTMLDoc.getElementById("USERNAME").Value = "xxxx" 'Entering credential
HTMLDoc.getElementById("PASSWORD").Value = "yyyyy"
End With
Set objCollection = IE.Document.getElementById("loginbutton")
objCollection.Click
'Second webpage
Do While IE.Busy Or IE.ReadyState <> 4: Loop ' opening the second webpage
Set HTMLDoc2 = IE.Document
With HTMLDoc2
**HTMLDoc2.getElementById("DEPARTMENTID").selectedindex = 1 'Drop down menu
HTMLDoc2.getElementById("DEPARTMENTID").FireEvent ("onchange")**
End With
Set objCollection = IE.Document.getElementById("loginbutton")
objCollection.Click
End Sub
Q)What code changes do I do to select Dwell_DF option Value 1567?
The above code gives run time error '424' : Object required.
HTMLDoc2.getElementById("DEPARTMENTID").selectedindex = 1 'Drop down menu
HTMLDoc2.getElementById("DEPARTMENTID").FireEvent ("onchange")
The above line give the error.
In the first webpage I fill the login credentials then in the next page is that of the image pasted with this post. Here I want to change the value in the drop down menu.
Give this a try. The value "1567" corresponds with the InnerText "Dwell_DF".
With HTMLDoc2
.getElementById("DEPARTMENTID").Focus
.getElementById("DEPARTMENTID").Value = "1567" 'You can also loop to find the text of the Option
.getElementById("DEPARTMENTID").FireEvent ("onchange")
End With
It should be something like this.
Sub passValueToComboBox1()
Dim ie As Object
Dim oHTML_Element As IHTMLElement
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://your_URL_here.php"
While ie.Busy Or ie.readyState <> 4: DoEvents: Wend
Set oHTML_Element = ie.document.getElementsByName("selectedReportClass")(0)
If Not oHTML_Element Is Nothing Then oHTML_Element.Value = "FUBU7"
For Each oHTML_Element In ie.document.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next
End Sub
Check out the link below for some other ideas of how to programatically interact with a web site.
http://vbadud.blogspot.com/2009/08/how-to-login-to-website-using-vba.html
I'm using Excel-vba, and trying to get the innerHTML of an InternetExplorer Object, my problem is that after clicking on a link, the innerHTML doesn't change and stays as the first navigation.
is there a way to get the innerHTML of the next page after clicking the link?
Here is the code:
Dim ie As InternetExplorer
Dim hd As HTMLDocument
Set ie = New InternetExplorer
ie.navigate "http://www.stormchaser.niu.edu/machine/textfcstsound.html"
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set hd = ie.document
hd.all.Item("mo")(4).Checked = True
hd.all.Item("ft")(11).Checked = True
Set objInputs = ie.document.getElementsByTagName("input")
For Each ele In objInputs
If ele.Type = "submit" Then
ele.Click
End If
Next
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
hd.Links(0).Click
Range("K4") = ie.document.body.innerHTML
I'd really thank for any help.
Jon
It looks likes a timing issue which I find is a very common problem in automating IE. The code is not waiting for the following page to load before executing hd.Links(0).Click so it is actually clicking a link on the old page. I tested the following code and it seems to run fine. It is using the page title as a check if it is loaded instead of ie.ReadyState which doesn't seem to be working.
Sub test()
Dim ie As InternetExplorer
Dim hd As HTMLDocument
Set ie = New InternetExplorer
ie.Navigate "http://www.stormchaser.niu.edu/machine/textfcstsound.html"
ie.Visible = True
Do While ie.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set hd = ie.Document
hd.all.Item("mo")(4).Checked = True
hd.all.Item("ft")(11).Checked = True
Set objInputs = ie.Document.getElementsByTagName("input")
For Each ele In objInputs
If ele.Type = "submit" Then
ele.Click
'Debug.Print ele.outerHTML
End If
Next
Do While hd.Title <> "Forecast Sounding Text Output for KOKC" ' ie.ReadyState <> READYSTATE_COMPLETE
'Debug.Print hd.Title, hd.Links(0)
'DoEvents
Loop
'While ie.ReadyState <> READYSTATE_COMPLETE: Wend
Set hd = ie.Document
Debug.Print hd.Title, hd.Links(0)
hd.Links(0).Click
'Do While ie.ReadyState <> READYSTATE_COMPLETE
' DoEvents
'Loop
While ie.ReadyState <> READYSTATE_COMPLETE: Wend
Do While hd.Title <> "" ' ie.ReadyState <> READYSTATE_COMPLETE
Loop
Debug.Print hd.Title, hd.body.innerHTML
Range("K4") = hd.body.innerHTML
End Sub
I would also suggest ie.Visible for debugging. Hope that helps.
I got it, you're right that it's a timing issue, I found out how to catch the right second for calling the innerHTML method without freezing Excel, it gives Excel a timeout of 20 seconds waiting for the new window, otherwise it returns "failed".
here is the full code:
Set ie = New InternetExplorer
ie.navigate "http://www.stormchaser.niu.edu/machine/textfcstsound.html"
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
Set hd = ie.document
T1 = ie.document.Title
hd.all.Item("mo")(4).Checked = True
hd.all.Item("ft")(10).Checked = True
hd.getElementById("stn").Value = "LLBG"
Set objInputs = ie.document.getElementsByTagName("input")
For Each ele In objInputs
If ele.Type = "submit" Then
ele.Click
End If
Next
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
T2 = Now
Do While (Now < T2 + TimeValue("0:00:20")) And ie.document.Title = T1
DoEvents
Loop
If ie.document.Title = T1 Then
Debug.Print "failed"
GoTo end_ext
End If
T1 = ie.document.Title
ie.document.Links(0).Click
Do While ie.readyState <> READYSTATE_COMPLETE
DoEvents
Loop
T2 = Now
Do While (Now < T2 + TimeValue("0:00:20")) And ie.document.Title = T1
DoEvents
Loop
If ie.document.Title = T1 Then
Debug.Print "failed"
GoTo end_ext
Else
'Debug.Print "succeeded"
End If
Debug.Print ie.document.body.innerText
end_ext:
ie.Quit
Set hd = Nothing
Set ie = Nothing
I'm trying to get data from the webpage.(some link)
In that webpage, there are many tickets(link) raised by customer. I need to go through each link and get some specific data from each tickets(link).
My program needs to click each review link and get some data from each link.
My program successfully picks the 1st ticket data but not all(click the 1st link and successfully get the 1st link data then it throws error).
it throws error(Access error)
Sorry my code is huge
Option Explicit
Sub AVS()
Dim ie As InternetExplorer
Dim iedoc As HTMLDocument
Dim innerString As String
Dim ttext As Integer
Dim avsHtmlTable As Object
Dim links As HTMLAnchorElement
Dim link As Object
Dim lRow As Integer
Set ie = New InternetExplorer
ie.Visible = True
ie.Navigate "https://apj-i.svcs.hp.com/itam-av1/"
Do While ie.Busy
DoEvents
Loop
Do Until ie.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
Set iedoc = ie.Document
With iedoc.forms("Login")
.all.Item("USER").Value = "Mail id goes here"
.all.Item("PASSWORD").Value = "pw goes here"
.submit
End With
Do While ie.Busy
DoEvents
Loop
Do Until ie.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
With iedoc.forms("aspnetForm")
.all.Item("ctl00$conNavBar$acpAssets_content$btnAssets-ExceptionSearch").Click
End With
Do While ie.Busy
DoEvents
Loop
Do Until ie.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
With iedoc.forms("aspnetForm")
.all.Item("ctl00$conMainPageContent$txtMaxRows").Value = 100
.all.Item("ctl00$conMainPageContent$rblStatus").Item(4).Checked = True
.all.Item("ctl00$conMainPageContent$btnAssetExceptionSearch").Click
End With
Do While ie.Busy
DoEvents
Loop
Do Until ie.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
With iedoc.forms("aspnetForm")
innerString = .innerText
ttext = InStr(innerString, "There are no results found for this query")
If Not ttext = 0 Then
MsgBox "There are no Tickets are there in AVS - Exception ", vbInformation, "AVS-Exception"
Else
''ctl00_conMainPageContent_grdAssetExceptionSearchResults
Set avsHtmlTable = iedoc.getElementsByTagName("a")
For Each link In avsHtmlTable
If link.innerHTML = "Review" Then
link.Click
Do While ie.Busy
DoEvents
Loop
Do Until ie.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
With Sheets("AVS")
set iedoc=ie.document
lRow = .Range("A10000").End(xlUp).Row
> ## ' error throws here
Range("A" & lRow).Value = iedoc.getElementById("ctl00_conMainPageContent_ddlAssignment").Value
End With
End If
Next link
End If
End With
End Sub
Sorry .. Not able to attach the image due to my 1st post.