So my new issue is that I cannot get the following code to stop looping. It seems as though my "do until element is nothing" line may not be completely accurate as the button I am attempting to click is not showing a "nothing" value at the end of the run. Here is the code with a brief description of the issue.
Sub SearchBot()
Dim objIE As InternetExplorer
Dim y As Integer
Dim result As String
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate "https://www.searchiqs.com/nyalb/Login.aspx"
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
objIE.document.getElementById("btnGuestLogin").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
objIE.document.getElementById("ContentPlaceHolder1_txtFromDate").Value = "07/11/2017"
objIE.document.getElementById("ContentPlaceHolder1_txtThruDate").Value = "07/13/2017"
objIE.document.getElementById("ContentPlaceHolder1_cboDocGroup").Value = "DBA"
objIE.document.getElementById("ContentPlaceHolder1_cmdSearch").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
y = 1
' brings up a table of results. I need to click on the view button and get the info from that page
objIE.document.getElementById("ContentPlaceHolder1_grdResults_btnView_0").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
' element ID's are hidden for those looking to help
result = Trim(objIE.document.getElementById("ContentPlaceHolder1_lblDetails2").innerText)
Sheets("Sheet1").Range("A" & y).Value = result
'Sheets("Sheet1").Range("C" & y).Value = result
y = y + 1
' I would love to direct link to the next search result here but the link does not change between pages so I click the next button
objIE.document.getElementById("ContentPlaceHolder1_btnNext").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
' I believe this is where the issue occurs
Do Until objIE.document.getElementById("ContentPlaceHolder1_btnNext") Is Nothing
result = Trim(objIE.document.getElementById("ContentPlaceHolder1_lblDetails2").innerText)
Sheets("Sheet1").Range("A" & y).Value = result
y = y + 1
' when the next page button is visible, it goes to the next page. When it is dimmed, the code continues. It doesn't stop unless I manually stop it. It takes the final page and repeats the process infinitely.
objIE.document.getElementById("ContentPlaceHolder1_btnNext").Click
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Loop
' I end up with a few good results in the beginning and then the final result repeats until I eventually stop the script.
End Sub
this is the html reading when the button is visible
<input name="ctl00$ContentPlaceHolder1$btnNext" title="Next Document" id="ContentPlaceHolder1_btnNext" style="width: 35px;" onclick="SaveDocListSelected();" type="submit" value=">>">
this is the html reading when the button is dimmed
<input name="ctl00$ContentPlaceHolder1$btnNext" title="Next Document" disabled="disabled" class="aspNetDisabled" id="ContentPlaceHolder1_btnNext" style="width: 35px;" type="submit" value=">>">
Any help is appreciated.
Related
I've created a script in vba using IE to fill in few inputs in a webpage in order to reach a new page to check for some items availability based on inputting some values in an inputbox.
To walk you through: what the script is currently doing:
Select Buy Bricks from landing page
Enter age 30 and country United Kingdom and then click on submit button
On the next page, enter the unique identification number for the Lego piece in the Element/design number box to populate result.
My script can satisfy all the requirements stated above. However, when I try with three different numbers, as in 4219725,765467 and 230223 I can see that the one in the middle 765467 doesn't populate any result but It prints the result of it's earlier number.
All the three numbers have been used in a for loop within my script below.
How can I make my script print nothing when there is no result instead of printing wrong result?
Site address
My script so far: (could not kick out hardcoded delay)
Sub GetDetails()
Const timeOut = 10
Dim IE As New InternetExplorer, Html As HTMLDocument
Dim elem As Object, post As Object, inputNum As Variant
Dim ageInput As Object, itm As Object, T As Date
With IE
.Visible = True
.navigate "https://www.lego.com/en-gb/service/replacementparts"
While .Busy Or .readyState < 4: DoEvents: Wend
Set Html = .document
Dim event_onChange As Object
Set event_onChange = .document.createEvent("HTMLEvents")
event_onChange.initEvent "change", True, False
Html.querySelectorAll(".arrow-list-info")(2).Click
Do: Set ageInput = Html.querySelector("input[id*='How old']"): DoEvents: Loop While ageInput Is Nothing
ageInput.innerText = 30
Html.querySelector("[label='United Kingdom").Selected = True
Html.querySelector("select").dispatchEvent event_onChange
Html.querySelector("[ng-click='startFlow()'").Click
While .Busy Or .readyState < 4: DoEvents: Wend
Set Html = .document
For Each inputNum In [{4219725,765467,230223}]
T = Timer
Do: Set post = Html.querySelector("[placeholder='Element/design number']"): DoEvents: Loop While post Is Nothing
post.ScrollIntoView
post.Focus
post.innerText = inputNum
Html.querySelector("button[ng-click='searchItemNumber()']").Click
'Can't kick out this hardcoded delay
Application.Wait Now + TimeValue("00:00:02")
Do
Set elem = Html.querySelector("div.list-item")
If Timer - T > timeOut Then Exit Do
DoEvents
Loop While elem Is Nothing
Set itm = Html.querySelector("h6.title")
If Not itm Is Nothing Then
Debug.Print itm.innerText
Else:
Debug.Print "Found Nothing"
End If
Next inputNum
Stop
End With
End Sub
So this needs tidying up but does it. I got rid of the explicit wait and added a wait for the spinner to disappear. For the no results section I look for an additional element to be present in the html when not found.
Option Explicit
Public Sub GetDetails()
Const timeOut = 10
Dim ie As New InternetExplorer, html As HTMLDocument
Dim elem As Object, post As Object, inputNum As Variant
Dim ageInput As Object, itm As Object, t As Date
With ie
.Visible = True
.navigate "https://www.lego.com/en-gb/service/replacementparts"
While .Busy Or .readyState < 4: DoEvents: Wend
Set html = .document
Dim event_onChange As Object
Set event_onChange = .document.createEvent("HTMLEvents")
event_onChange.initEvent "change", True, False
html.querySelectorAll(".arrow-list-info")(2).Click
Do: Set ageInput = html.querySelector("input[id*='How old']"): DoEvents: Loop While ageInput Is Nothing
ageInput.innerText = 30
html.querySelector("[label='United Kingdom']").Selected = True
html.querySelector("select").dispatchEvent event_onChange
html.querySelector("[ng-click='startFlow()']").Click
While .Busy Or .readyState < 4: DoEvents: Wend
For Each inputNum In [{4219725,765467,230223}]
Do: Set post = .document.querySelector("[placeholder='Element/design number']"): DoEvents: Loop While post Is Nothing
post.Focus
post.innerText = inputNum
html.querySelector("button[ng-click='searchItemNumber()']").Click
Do
Loop While .document.querySelectorAll(".basic-search-btn .icon-spinner-arrows").Length > 0
t = Timer
Do
Set elem = html.querySelector("div.list-item")
If Timer - t > timeOut Then Exit Do
DoEvents
Loop While elem Is Nothing
Set elem = Nothing
Set itm = html.querySelector("h6.title")
If html.querySelectorAll(".alert.alert-info.margin-top.ng-hide").Length = 1 Then
Debug.Print "Found nothing"
Else
Debug.Print itm.innerText
End If
Set itm = Nothing
Next inputNum
ie.Quit
End With
End Sub
The below code opens an instance of InternetExplorer and downloads odds. It works fine but occasionally a pop-up window appears which causes the code to not work. Any help on how to navigate the below pop-up (i.e. click 'continue to oddschecker') when the pop-up does appear?
<a class="continue beta-callout js-close-class" onclick='s_objectID="javascript:void(0)_9";return this.s_oc?this.s_oc(e):true' href="javascript:void(0)">Continue to Oddschecker</a>
Full code:
Sub Oddschecker()
Dim ie, wp As Object
Dim i As Integer
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.Navigate "https://www.oddschecker.com/horse-racing/racing-coupon"
Do While ie.Busy
DoEvents
Loop
Do While ie.ReadyState <> 4
DoEvents
Loop
Set wp = ie.Document
'Application.ActiveSheet.UsedRange.ClearContents
Application.Worksheets("sheet1").UsedRange.ClearContents
i = 2
For Each rw In wp.getElementsByTagName("table")(0).getElementsByTagName("tr")
If rw.className = "date" Then
Worksheets("sheet1").Range("A1") = rw.innerText
ElseIf rw.className = "fixture-name" Then
i = i + 1
Worksheets("sheet1").Range("A" & i) = rw.getElementsByTagName("td")(0).innerText
i = i + 1
ElseIf rw.className = "coupons-table-row match-on" Then
For Each od In rw.getElementsByTagName("p")
If InStr(od.innerText, "(") <> 0 Then
Worksheets("sheet1").Range("A" & i) = Trim(Left(od.innerText, InStr(od.innerText, "(") - 1))
np = Trim(Right(od.innerText, Len(od.innerText) - InStr(od.innerText, "(")))
Worksheets("sheet1").Range("B" & i) = Left(np, Len(np) - 1)
i = i + 1
Else
Worksheets("sheet1").Range("A" & i) = Trim(od.innerText)
i = i + 1
End If
Next od
End If
Next rw
ie.Quit
Range("A1:B" & i).WrapText = False
Columns("A:B").EntireColumn.AutoFit
Set wp = Nothing
Set ie = Nothing
End Sub
If you wish to continue with that page (navigating to that popup page), you can try like:
Dim HTML As HTMLDocument, addcheck As Object
While IE.Busy = True Or IE.readyState < 4: DoEvents: Wend ''(You can write it the way you feel comfortable)
Set HTML = IE.document ''place this line after the prevous line
Set addcheck = HTML.querySelector("#promo-modal a.continue")
If Not addcheck Is Nothing Then
addcheck.Click
End If
But, that is not a good idea cause it will lead you to some page where you might need to do some activity to get back on this data ridden page.
I suppose you should get rid of that popup blocker by ticking the cross button located on the top right area and continue to do what you are doing:
Dim HTML As HTMLDocument, addcheck As Object
While IE.Busy = True Or IE.readyState < 4: DoEvents: Wend ''(You can write it the way you feel comfortable)
Set HTML = IE.document ''place this line after the prevous line
Set addcheck = HTML.querySelector("#promo-modal span[title='Close")
If Not addcheck Is Nothing Then
addcheck.Click
End If
If I didn't understand what your intention was, do let me know. Thanks.
I am trying to make a simple spreadsheet that will take addresses and look up the +4 zip from the USPS website. I have done this with success, but the results seem to be inconsistent. I can run this code one time and it will work great and other time it will not return the +4. Is there a more efficient way of writing this?
Sub ZipCodeSearch()
Dim objIE As InternetExplorer
Dim result As String
'start IE and Navigate to USPS
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate "https://tools.usps.com/go/ZipLookupAction_input"
'Wait for the website to load
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
'Fill in Street Address
objIE.document.getElementById("tAddress").Value = Sheets("Sheet1").Range("A2")
'Fill in City
objIE.document.getElementById("tCity").Value = Sheets("Sheet1").Range("B2")
'Fill in State-Need to figure out how to select the roller.
'objIE.document.getElementById("select-frame").Value = Sheets("Sheet1").Range("C1")
'Click the find Button
objIE.document.getElementById("lookupZipFindBtn").Click
'Wait on Search
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
'Get Reslts)
For Each aEle In objIE.document.getElementsByClassName("zip4")
result = aEle
'Put Results in Worksheet
Sheets("Sheet1").Range("E2").Value = aEle.innerText
Debug.Print aEle.innerText
Next
'Quit Internet Explore
objIE.Quit
I am running into a bit of a problem. Normally when I pull a table I use the "data from web" tool in excel, however I now have quite a few places I need to pull data that first require me to enter a username and password. I figured out some code for that (though probably not the most elegant) but realized that once I get to my desired page I have no idea how to extract the table. Here is what I have so far.
Sub Login()
Sheets("IOL").Select
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
ie.Navigate ("https://internalsite.company.com/secure/login" & ActiveCell)
Do
If ie.ReadyState = 4 Then
ie.Visible = True
Exit Do
Else
DoEvents
End If
Loop
ie.Document.forms(0).all("badgeBarcodeId").Value = "00000"
ie.Document.forms(0).submit
'used because it redirects to a new page after submitting and I couldn't figure out how to make it wait for the new page to load before proceeding.
Application.Wait (Now + TimeValue("0:00:02"))
ie.Document.forms(0).all("password").Value = "00000"
ie.Document.forms(0).submit
End Sub
After the login is accomplished I would like to go to http://internalsite.company.com/csv and import the csv directly into a sheet. Anytime I make a new connection it makes me log in again so I figure there has to be a way to extract the file without adding a new connection. I'm pretty new with more complex VBA so bear with me.
I was able to get this code to do the job, but it is more preferable to get the CSV directly instead of the table. Sometimes the table doesn't like to load.
Sub Login()
Dim clip As DataObject
Dim ieTable As Object
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
ie.Navigate ("https://internalsite1.company.com/secure/login" & ActiveCell)
Do
If ie.ReadyState = 4 Then
ie.Visible = True
Exit Do
Else
DoEvents
End If
Loop
ie.Document.forms(0).all("badgeBarcodeId").Value = "00000"
ie.Document.forms(0).submit
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: DoEvents: Loop
ie.Document.forms(0).all("password").Value = "000000"
ie.Document.forms(0).submit
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: DoEvents: Loop
ie.Navigate "http://internalsite2.company.com/site/Inbound?filter=1To3Days"
Do While ie.Busy: DoEvents: Loop
Do Until ie.ReadyState = 4: DoEvents: Loop
Set ieTable = ie.Document.all.Item("DataTables_Table_0")
If Not ieTable Is Nothing Then
Set clip = New DataObject
clip.SetText "" & ieTable.outerHTML & ""
clip.PutInClipboard
Workbooks("Production Meeting Dashboard.xlsm").Activate
Sheets("IOL").Select
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Unicode Text", link:=False, _
DisplayAsIcon:=False, NoHTMLFormatting:=True
End If
End Sub
This little script is supposed to go to the website
http://finra-markets.morningstar.com/BondCenter/Default.jsp
Insert under the tab "Search" inside the "Symbol/Cusip" box the number 111320AE7 and click on the "Show Results" button to get the results.
Sub SearchSite()
Dim beta
Dim objIE As InternetExplorer
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate "http://finra-markets.morningstar.com/BondCenter/Default.jsp"
Do While objIE.Busy = True Or objIE.readyState <> 4
DoEvents
Loop
objIE.document.getElementById("firscreener-cusip").Value = "111320AE7"
Set beta = objIE.document.getElementsByClassName("ms-finra-advanced-search-btn")(1)
beta.Click
Do While objIE.Busy = True Or objIE.readyState <> 4
DoEvents
Loop
'objIE.Quit
End Sub
I get Run-time error 91: Object variable or With block variable not set
The problem appears to be the beta.click line
I would appreciate some help.
Thanks a lot.
Beta is referencing the div that contains the buttons. The element arrays are base 0. They start at 0 not 1.
Sub SearchSite()
Dim beta, buttons, btnReset, btnSubmit
Dim objIE As InternetExplorer
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate "http://finra-markets.morningstar.com/BondCenter/Default.jsp"
Do While objIE.Busy = True Or objIE.readyState <> 4
Loop
objIE.document.getElementById("firscreener-cusip").Value = "111320AE7"
Set beta = objIE.document.getElementsByClassName("ms-finra-advanced-search-btn")(0)
' <div class="ms-finra-advanced-search-btn">
' <input class="button_blue" value="CLEAR CRITERIA" type="reset">
' <input class="button_blue" value="SHOW RESULTS" type="submit">
' </div>
Set buttons = beta.GetElementsByTagName("input")
WScript.Echo buttons(0).outerHTML
' <input class="button_blue" value="CLEAR CRITERIA" type="reset">
Set btnReset = buttons(0)
' <input class="button_blue" value="SHOW RESULTS" type="submit">
Set btnSubmit = buttons(0)
beta.btnSubmit
Do While objIE.Busy = True Or objIE.readyState <> 4
Loop
objIE.Quit
End Sub