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
Related
Hi I'm trying to get VBA to run a script to bring back all the links from the first page after running a google search, but it doesn't consistently search all the cells in the column.
Also can anyone help me get the hyperlinks and innertext separate? Here's a copy of the code below:
'Start the bot called SearchBot
Sub SearchBot()
'declare/set aside memory for our variables
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = ActiveSheet
For h = 1 To ws.Range("A1").CurrentRegion.Rows.Count
Dim objIE As Object
Dim aEIe As HTMLLinkElement
Dim y As Integer
Dim result As String
'Start Internet Explorer
Set objIE = New InternetExplorer
'Make Internet Explorer Visible
objIE.Visible = True
'navigate to the google webpage
objIE.navigate "google.com"
'Wait for a few seconds while the browser is busy
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
'in the search box enter the field from the cell and press search
objIE.document.getElementsByName("q")(0).Value = ws.Cells(h, 1).Value
SendKeys "{Enter}"
'Wait again for the browser to finish
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
ws.Cells(h, 2).Select
x = 0
For Each aEIe In objIE.document.getElementsByClassName("r")
ActiveCell = objIE.document.getElementsByClassName("r")(x).innerText
ActiveCell.Offset(0, 1).Select
x = x + 1
Next
objIE.Quit
Next
End Sub
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
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
I'm trying to automate a task in excel that requires opening a webpage, navigating to a link on that page, and then clicking on a button on the second page to download an .xlsx file.
I've written a script that should do this. However, the response I get from the webpage is not always the same. In particular, sometimes this will return a download from the first page and sometimes it will navigate to the second page and not download anything, once or twice it has done both.
My sense is that this has to do with how long it takes for InternetExplorer.application to complete a request. I can't figure out how to troubleshoot this though, given that I tell the script to wait for IE.application to complete its request.
Sub DoBrowse2()
'For Each lnk In Sheets("Sheet4").Hyperlinks
'Range(lnk).Hy.Follow
'Next
Dim i As Long
Dim URL As String
Dim BaseURL As String
Dim ToURL As String
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
Dim HWNDSrc As Long
Dim html As IHTMLDocument
Set IE = CreateObject("InternetExplorer.Application")
URL = Range("B2").Hyperlinks(1).Address
IE.Navigate URL
IE.Visible = True
Application.StatusBar = URL & " is loading. Please wait..."
Do While IE.ReadyState = 4: DoEvents: Loop
Do Until IE.ReadyState = 4: DoEvents: Loop
Application.StatusBar = URL & " Loaded"
'Set html = IE.Document
'Dim elements As IHTMLElementCollection
'Set elements = html.all
For Each itm In IE.Document.all
If itm.className = "datagrid" Then
For Each el In itm.Document.all
Debug.Print "hello"
If el.className = "ujump" And Right(el.innerText, 12) = "Constituents" Then
'Debug.Print el.innerText
ToURL = el.getAttribute("data-subset")
BaseURL = "http://datastream.thomsonreuters.com/navigator/search.aspx?dsid=ZUCH002&AppGroup=DSAddin&host=Metadata&prev=scmTELCMBR&s=D&subset="
ToURL = BaseURL & ToURL
'Debug.Print ToURL
IE.Navigate ToURL
IE.Visible = True
Do While IE.Busy
Debug.Print "in busy loop"
Application.Wait DateAdd("s", 1, Now)
Loop
GoTo end_of_for
End If
Next
End If
Next
end_of_for:
Debug.Print ("STOP STOP STOP STOP STOP")
Dim Script As String
For Each itm In IE.Document.all
If itm.className = "lgc excel" Then
Debug.Print "hello world"
Debug.Print itm.getAttribute("onclick")
itm.Click
Do While IE.Busy
Debug.Print "app busy"
Application.Wait DateAdd("s", 1, Now)
Loop
Exit For
End If
Next
End Sub
Thanks in advance for your help.
Use this to determine whether IE page has been fully loaded, it always must be both of these conditions:
Do Until ie.ReadyState = 4 And ie.Busy = False
DoEvents
Loop
Even with code above if there are scripts on the page, some content may be loaded after ie.ReadyState = 4 And ie.Busy = False condition is met and either easy way, but inefficient and unreliable Application.Wait can be used or you can try finding elements on the website which inform about loading state and determine the state by their visible attributes etc.
Part of your code is wrong and causes an endless loop:
Do While IE.ReadyState = 4: DoEvents: Loop
Do Until IE.ReadyState = 4: DoEvents: Loop
It makes DoEvents fire while readystate is complete and also until it reaches complete status.
Narrow down a collection of all elements:
For Each itm In IE.Document.all
to a specific collection for better performance when possible, for example:
For Each itm In IE.Document.GetElementsByTagName("div")
I am in need of assistance. I am trying to write a VBA script that would take the value in column A and place it on an online form in an input element with no ID but the name ("OldUrl"). Then the VBA script would take the value in the adjacent cell in column B and place that in the same form ("digiSHOP") in the input field named ("NewUrl").
The form is on a secure server however I have gotten as far as the window pulling up and the form selected. I am having trouble finding a way to target the input field since they have no ID. Below is my code and thank you for your help.
Sub Redirect()
Dim IE As Object
Dim doc As Object
Dim form As Object
Dim OldURL As Object
Dim NewURL As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate "https://...."
Do Until .ReadyState = 4: DoEvents: Loop
Set doc = IE.Document
Set form = doc.forms("digiSHOP")
Set OldURL = doc.getElementById("OldUrl")'Error occurs here. Element has no ID
OldURL.Value = Range("A2")
Set NewURL = doc.getElementById("NewUrl")
NewURL.Value = Range("B2")
form.submit
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
End With
End Sub
Also I wasn't sure how to target the entire column and loop it therefore the Value is set to the cell A2. This was more to test the script.
Sub Redirect()
Dim IE As Object
Dim doc As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate "https://...."
Do Until .ReadyState = 4: DoEvents: Loop
With .Document.forms("digiSHOP")
.elements("OldUrl").Value = Range("A2")
.elements("NewUrl").Value = Range("B2")
.submit
End With
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
End With
End Sub