I'm trying to scrape zip codes from Google. I've been trying to put innertext into a cell, but I think I may be getting a variable mismatch on 2nd to last line.
'This Must go at the top of your module. It's used to set IE as the active window
Sub Automate_IE_Enter_Data()
'This will load a webpage in IE
Dim i As Long
Dim URL As String
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
Dim HWNDSrc As Long
Dim adds As Variant, add As Variant
Dim addt As String
'Create InternetExplorer 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.google.com/search?ei=djKhW7nELYqs8AO96baoAw&q=1000 Westover Rd kansas city, Mo"
'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 inadvertantly skipping over the second loop)
Do While IE.ReadyState = 4: DoEvents: Loop
Do Until IE.ReadyState = 4: DoEvents: Loop
'Webpage Loaded
Application.StatusBar = URL & " Loaded"
'Get Window ID for IE so we can set it as activate window
HWNDSrc = IE.Hwnd
'Set IE as Active Window
'SetForegroundWindow HWNDSrc
Debug.Print "ihgc"
'Unload IE
endmacro:
Set adds = IE.Document.getElementsbyClassName("desktop-title-subcontent")
For Each add In adds
Debug.Print add.innertext
Next
Cells(2, f).Value = add.innertext
End Sub
Couple of things. First and foremost, your loop is unnecessary. I ran your code, and there's nothing to loop. Even if it was necessary, it's being used improperly.
So, in assuming that you in fact do not need a For...Next loop, then you can use the index number of 0 for your collection of IE.Document.getElementsbyClassName("desktop-title-subcontent"), then set your cell reference equal to the innerText property of that collection item.
This brings me to the next issue, your cell reference. Cells(2, f), the f is not a declared variable. If you where actually wanting to use the column "F", then you need to enclose 'F' in double quotes:
Cells(2, "F") or use the column's index of 6, Cells(2, 6)
So, replace this entire portion:
Set adds = IE.Document.getElementsbyClassName("desktop-title-subcontent")
For Each add In adds
Debug.Print add.innertext
Next
Cells(2, f).Value = add.innertext
with this:
Cells(2, "F").Value = IE.Document.getElementsByClassName _
("desktop-title-subcontent")(0).innerText
OPTIONAL
And lastly, I would look into using Early Binding over late binding. It has many advantages, with a possible notable speed improvement.
You would need to set a reference to Microsoft Internet Controls and declare IE as type InternetExplorer vs Object. But that's not going to make or break your code.
Related
I'm currently trying to create a sheet which will extract tracking information for parcels sent out. I've worked out the following code for the time being but encounter the following issues:
The code continues before the page fully loads, I suspect this may be because after the initial loading is complete, it runs a script and refreshes.
If mouse is not rolling over Internet Explorer, high probability of a human verification with images. I understand this may not be possible to avoid but is there any way I can pause the script while someone completes the verification?
Sub RoyalTrack()
Dim i As Long
Dim ie As Object
Dim t As String
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate "https://www.royalmail.com/track-your-item#/tracking-results/SF511991733GB"
.Resizable = True
End With
While ie.ReadyState <> 4 Or ie.Busy: DoEvents: Wend
Dim full As Variant
Dim latest As Variant
full = ie.Document.getElementsByClassName("c-tracking-history")(0).innerText
latest = ie.Document.getElementsByClassName("tracking-history-item ng-scope")(0).innerText
MsgBox full
MsgBox latest
End Sub
Managed to figure it out. Added a 2 second wait after page loads to allow loading and an error handler to identify if the required property is available.
Sub RoyalTrack()
Dim i As Long
Dim ie As Object
Dim t As String
Dim trackingN As String
Dim count As Integer
count = 2
Do While Worksheets("Sheet1").Range("D" & count).Value <> ""
Set ie = CreateObject("InternetExplorer.Application")
trackingN = Worksheets("Sheet1").Range("D" & count).Value
With ie
.Visible = True
' Variable tracking SF-GB
.Navigate "https://www.royalmail.com/track-your-item#/tracking-results/" & trackingN
.resizable = True
End With
While ie.readyState <> 4 Or ie.Busy: DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:02"))
Dim full As Variant
Dim latest As Variant
On Error Resume Next
latest = ie.document.getElementsByClassName("tracking-history-item ng-scope")(0).innerText
If Err Then
MsgBox "Prove your humanity if you can"
Err.Clear
End If
latest = ie.document.getElementsByClassName("tracking-history-item ng-scope")(0).innerText
Windows("Book1.xls").Activate
Sheets("Sheet1").Select
Range("E" & count).Value = latest
ie.Quit
Set ie = Nothing
count = count + 1
Loop
End Sub
'start a new subroutine called SearchBot
Sub SearchBot()
'dimension (declare or set aside memory for) our variables
Dim objIE As InternetExplorer 'special object variable representing the IE browser
Dim aEle As HTMLLinkElement 'special object variable for an <a> (link) element
Dim y As Integer 'integer variable we'll use as a counter
Dim result As String 'string variable that will hold our result link
Dim x As Integer
Application.ScreenUpdating = False
' Set numrows = number of rows of data.
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
' Select cell a1.
Range("A1").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
' Insert your code here.
'initiating a new instance of Internet Explorer and asigning it to objIE
Set objIE = New InternetExplorer
'make IE browser visible (False would allow IE to run in the background)
objIE.Visible = True
'navigate IE to this web page (a pretty neat search engine really)
objIE.navigate "http://ec.europa.eu/taxation_customs/vies/vatResponse.html"
'wait here a few seconds while the browser is busy
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
'in the search box put cell "A2" value, the word "in" and cell "C1" value
objIE.document.getElementById("countryCombobox").Value = "GB"
objIE.document.getElementById("number").Value = ActiveCell.Value
'click the 'go' button
objIE.document.getElementById("submit").Click
'wait again for the browser
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Dim vatResponse As String
vatResponse = objIE.document.getElementById("vatResponseFormTable").getElementsByTagName("tr")(0).Children(0).textContent
ActiveCell.Offset(0, 2).Value = vatResponse
' Selects cell down 1 row from active cell.
'Next
Application.ScreenUpdating = True
'close the browser
objIE.Quit
ActiveCell.Offset(1, 0).Select
'End
Next
'exit our SearchBot subroutine
End Sub
So basically on this code line:
vatResponse = objIE.document.getElementById("vatResponseFormTable").getElementsByTagName("tr")(0).Children(0).textContent
I am getting an error message saying that I have an error code 424
Sometimes the pages gets loaded internally through some scripts so the html element you are trying to get actually isn't found on the document as the code runs very fast. So somehow you have to wait until page loads completely.
Please try this approach and see if the code runs without producing an error.
Sub SearchBot()
'dimension (declare or set aside memory for) our variables
Dim objIE As InternetExplorer 'special object variable representing the IE browser
Dim aEle As HTMLLinkElement 'special object variable for an <a> (link) element
Dim vatFormTable As IHTMLElement
Dim tr As IHTMLElement
Dim y As Integer 'integer variable we'll use as a counter
Dim result As String 'string variable that will hold our result link
Dim x As Integer
Application.ScreenUpdating = False
' Set numrows = number of rows of data.
NumRows = Range("A" & Rows.Count).End(xlUp).Row
' Select cell a1.
Range("A1").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
' Insert your code here.
'initiating a new instance of Internet Explorer and asigning it to objIE
Set objIE = New InternetExplorer
'make IE browser visible (False would allow IE to run in the background)
objIE.Visible = True
'navigate IE to this web page (a pretty neat search engine really)
objIE.navigate "http://ec.europa.eu/taxation_customs/vies/vatResponse.html"
'wait here a few seconds while the browser is busy
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
'in the search box put cell "A2" value, the word "in" and cell "C1" value
objIE.document.getElementById("countryCombobox").Value = "GB"
objIE.document.getElementById("number").Value = ActiveCell.Value
'click the 'go' button
objIE.document.getElementById("submit").Click
'wait again for the browser
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
On Error Resume Next
Dim vatResponse As String
Do While vatFormTable Is Nothing
Set vatFormTable = objIE.document.getElementById("vatResponseFormTable")
Loop
Do While tr Is Nothing
Set tr = vatFormTable.getElementsByTagName("tr")(0)
Loop
vatResponse = tr.Children(0).innerText
ActiveCell.Offset(0, 2).Value = vatResponse
' Selects cell down 1 row from active cell.
'Next
Application.ScreenUpdating = True
'close the browser
objIE.Quit
ActiveCell.Offset(1, 0).Select
'End
Next
'exit our SearchBot subroutine
End Sub
I'm trying to use Excel VBA to pull the info from columns A2-D2 and enter it into the web site and then click the "Next" button. The code below is what I have so far which works fine for entering the info found on row 2 only.
I'm hoping to achieve that IE opens a new window, enters the values in cells A2 through D2, clicks the "Next" button, and then loops to open another new IE window and enters the values in cells A3 through D3 until it hits an empty cell.
Here are the current numbers that I'm using for testing, http://imgur.com/a/88XEF.
Thanks in advance for any suggestions.
Sub FillInternetForm()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
'create new instance of IE. use reference to return current open IE if
'you want to use open IE window. Easiest way I know of is via title bar.
IE.Navigate "https://mygift.giftcardmall.com/Card/Login?returnURL=Transactions"
'go to web page listed inside quotes
IE.Visible = True
While IE.busy
DoEvents 'wait until IE is done loading page.
Wend
'pause if needed
Application.Wait Now + TimeValue("00:00:02")
IE.Document.All("CardNumber").Value = ThisWorkbook.Sheets("sheet1").Range("a2")
IE.Document.All("ExpirationMonth").Value = ThisWorkbook.Sheets("sheet1").Range("b2")
IE.Document.All("ExpirationYear").Value = ThisWorkbook.Sheets("sheet1").Range("c2")
IE.Document.All("SecurityCode").Value = ThisWorkbook.Sheets("sheet1").Range("d2")
'presses the next button
Set tags = IE.Document.GetElementsByTagname("Input")
For Each tagx In tags
If tagx.Value = "Next" Then
tagx.Click
Exit For
End If
Next
End Sub
You just need to wrap your code in a loop..
Dim i as integer
i = 2
do while (ThisWorkbook.Sheets("sheet1").cells(i, 1).value <> "")
'your code from Application.wait line to end of next button click
i = i + 1
loop
This assumes an empty row can be identified by column A being empty. You could change the condition on the while loop if this assumption is bad
sorry had to right a new answer because the formatting was going weird
ok makes sense, you just need to move the start of your loop further up the code so it encases the creation of the IE object and the navigation, you should also close the IE window before opening a new one:
move the chunk:
Dim i as integer
i = 2
do while (ThisWorkbook.Sheets("sheet1").cells(i, 1).value <> "")
right up to the top right after:
Sub FillInternetForm()
Add the following lines after the line "Next" right at the bottom but still enclosed by the loop
IE.Quit
Set IE = Nothing
I was able to accomplish what I wanted with the following. Thanks to those that commented.
Sub FillInternetForm()
Range("A2").Select
Do Until IsEmpty(ActiveCell)
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
'create new instance of IE. use reference to return current open IE if
'you want to use open IE window. Easiest way I know of is via title bar.
IE.Navigate "https://mygift.giftcardmall.com/Card/Login?returnURL=Transactions"
'go to web page listed inside quotes
IE.Visible = True
While IE.busy
DoEvents 'wait until IE is done loading page.
Wend
'pause if needed
Application.Wait Now + TimeValue("00:00:02")
IE.Document.All("CardNumber").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
IE.Document.All("ExpirationMonth").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
IE.Document.All("ExpirationYear").Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
IE.Document.All("SecurityCode").Value = ActiveCell.Value
ActiveCell.Offset(1, -3).Select
'presses the next button
Set tags = IE.Document.GetElementsByTagname("Input")
For Each tagx In tags
If tagx.Value = "Next" Then
tagx.Click
Exit For
End If
Next
Loop
End Sub
Please see the code below. I am compiling a list of unusual currency pairings in excel and I wish to scrape this data with VBA. I only want to insert the value itself into the cell. Does anyone know where I am going wrong here? I am getting a 'Run-time error '91': object variable or With block variable not set'. I'm relatively new to VBA and i've put a lot a deal of thought into this.
Sub ie_open()
Dim wb As Workbook
Dim ws As Worksheet
Dim TxtRng As Range
Dim ie As Object
Set ie = CreateObject("INTERNETEXPLORER.APPLICATION")
ie.NAVIGATE "http://www.barchart.com/quotes/forex/British_Pound/Costa_Rican_Colon/%5EGBPCRC"
ie.Visible = True
While ie.ReadyState <> 4
DoEvents
Wend
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Test Sheet")
Set TxtRng = ws.Range("A1")
TxtRng.Value = ie.document.getelementsbyname("divQuotePage").Item.innertext
End Sub
This is the data which I am trying to scrape:
Thanks.
I'm not that accomplished at web scraping, but that kind of error often means that what you are looking for isn't there. In particular, I don't see divQuotePage in the screen shot you provided.
But if you want the quote (793.19) you could do something like:
Dim V As Variant
Set V = ie.document.getelementbyid("dtaLast")
TxtRng = V.innertext
This will work.
Sub Test()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate "http://www.barchart.com/quotes/forex/British_Pound/Costa_Rican_Colon/%5EGBPCRC" ' should work for any URL
Do Until .ReadyState = 4: DoEvents: Loop
x = .document.body.innertext
y = InStr(1, x, "Last Price")
Z = Mid(x, y, 19)
Range("A1").Value = Trim(Z)
.Quit
End With
End Sub
You can target that element with a CSS selector of div.pricechangerow > span.last-change;
which can be simplified to .last-change.
The "." means class and you can retrieve this specific item with
Debug.Print ie.document.querySelector.querySelector(".last-change").innerText
That is for the website's current incarnation at 2018-06-30
Can't get the "GO" button to click via VBA on this site: https://finra-markets.morningstar.com/BondCenter/BondDetail.jsp?ticker=C631551&symbol=RDS4242315
Will eventually want to loop code. Should be simple...just can't get this one.
Sub Macro1()
'we define the essential variables
Dim ie As Object
Dim acct
Dim button
Set Rng = Range("B4:B4")
Set Row = Range(Rng.Offset(1, 0), Rng.Offset(1, 0).End(xlDown))
For Each Row In Rng
'add the "Microsoft Internet Controls" reference in your VBA Project indirectly
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.navigate ("https://finra-markets.morningstar.com/BondCenter/BondDetail.jsp?ticker=C631551&symbol=RDS4242315")
While ie.ReadyState <> 4
DoEvents
Wend
Set Cusip = .document.getElementById("ms-finra-autocomplete-box") 'id of the username control (HTML Control)
Cusip.Value = Range("B" & Row.Row).Value
ie.document.getElementsByTagName("submit").Click
End With
Next Row
End Sub
The tag name of your button is not "submit" but "INPUT" ... "submit" is the type.
But watch out, there are more INPUT elements, so your getElementsBy... will return a collection and you need to further dig to find the correct one, e.g. by checking a significant attribute.
Example
' ...
Set ECol = ie.document.getElementsByTagName("input")
For Each IFld In ECol
If IFld.getAttribute("class") = "button_blue autocomplete-go" Then
IFld.Click
Exit For
End If
Next IFld
' ...