VBA - Excel - Automation Error Unspecified Error - excel

So I ran into a slight stumbling block and hopefully here someone can help me. In short, I need to visit a string of webpages (the list of the names on each page are already input, that code works fine). As my code visits each page, I need to pull back information. Unfortunately, there's a problem - it can't even make it through the "A" list before I get "Automation Error Unspecified Error" and it's never at the same spot.
I've tried the "normal" steps to fix this. I've installed the VB 6 Controls and I've unregistered and re-registered mscomctl.ocx, and including On Error Resume Next (which doesn't do anything).
It usually reaches over 100 cases before it dies (randomly as I said earlier). And AFTER the error pops up, when I try to re-run it (with or without changes) and it errors on the first one. If I restart my computer it will let me try again (for whatever reason) but it still doesn't finish.
Is the code too complex and I need to reduce it? I can probably find a way to make it only run for each letter at a time (run all A's, then do B's, etc) but I still can't even get it to complete the letter A.
I noticed in another thread someone had suggested instead of using IE to swap to xmlhttp - is that a fix for this? Is the problem that this script is too long? What exactly am I doing wrong here?
Sub Lookup()
Range("AI1").Value = "Unique ID"
Range("AJ1").Value = "Name"
Range("AK1").Value = "Birth Year"
Range("AL1").Value = "Title"
Range("AM1").Value = "State"
Range("AN1").Value = "Position"
Range("AO1").Value = "Country"
Range("AP1").Value = "Appointed"
Range("AQ1").Value = "Credentials"
Range("AR1").Value = "Terminations"
Dim i As Integer
For i = 1 To 26
If i = 24 Then
Range("X:X").End(xlUp).Select
ActiveCell.Value = ""
Else
Dim ic As String
ic = LCase(ConvertToLetter(i))
Range(ic & "5000").End(xlUp).Select
Dim J As Integer
J = ActiveCell.Row
Dim k As Integer
For k = 2 To J
Range(ic & k).Select
Dim Lookup As String
Lookup = ActiveCell.Value
Dim IE As Variant
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.navigate "http://history.state.gov/departmenthistory/people/" & Lookup
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
Dim Italics As Integer
Italics = 0
Dim EachA As Integer
For EachA = 64 To 100
Dim Position As String
Position = Doc.getElementsByTagName("a")(EachA).innerText
If Position = "Home" Then
Exit For
Else
Dim NameBY As String
NameBY = Doc.getElementsByTagName("h2")(1).innerText
Dim TitleST As String
TitleST = Doc.getElementsByTagName("p")(1).innerText
Range("AJ" & "90000").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = NameBY
TitleState = Split(TitleST, vbLf)
ActiveCell.Offset(0, 2).Value = TitleState(0)
On Error GoTo 1037
ActiveCell.Offset(0, 3).Value = TitleState(1)
On Error GoTo 1037
1037
ActiveCell.Offset(0, 4).Select
ActiveCell.Value = Position
Dim EachLi As Integer
EachLi = EachA - 1
If Doc.getElementsByTagName("li").Item(EachLi + Italics).innerHTML Like "<em>*" Then
Italics = Italics + 1
Else
End If
Dim JobList As String
JobList = Doc.getElementsByTagName("li")(EachLi + Italics).innerText
Dim Job() As String
Job() = Split(JobList, vbLf)
Dim JCount As Integer
For JCount = LBound(Job) To UBound(Job)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Job(JCount)
Next JCount
End If
Next EachA
Next k
End If
Next i
End Sub

One thing I notice is that you're continually creating new IE objects inside the loop, and you're never destroying them or setting to Nothing. It's pointless, expensive, and possibly a source of error to be creating 100+ instances of IE.
I think it will probably help to create a single instance of IE initially, and then use that same object inside the loop to navigate the desired URLs.
So instead of this:
Dim IE As Variant
Set IE = CreateObject("InternetExplorer.Application")
Do this:
Dim IE as Object
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")

Related

Excel Macro To Pull Google Image Links

The goal is to get images from Google Images that match the part numbers in my database. My code runs, and it pulls up the correct Google pages but refuses to put the links into the spreadsheet. I have tried everything I can think of, but as of now, I keep on getting Error 1004 (Application-defined or Object-defined error).`
Sub SearchBotGoogleImgLink()
Dim objIE As Object
Set IE = CreateObject("InternetExplorer.Application")
Dim HTMLdoc As HTMLDocument
Dim imgElements As IHTMLElementCollection
Dim imgElement As HTMLImg
Dim aElement As HTMLAnchorElement
Dim n As Integer
Dim i As Integer
Dim url As String
Dim url2 As String
Dim m As Long
Dim lastRow As Long
Dim url3 As String
Dim SearchRow As Long
Dim aEle As HTMLLinkElement
Worksheets("Sheet1").Select
SearchRow = 1
Do Until IsEmpty(ActiveSheet.Cells(SearchRow, 1))
Sheets("Sheet1").Select
Application.StatusBar = SearchRow - 1 & " of " & "4368" & " Items Done"
Item = Trim(ActiveSheet.Cells(SearchRow, 1))
url = "https://www.google.com/search?hl=en&biw=1600&bih=796&tbm=isch&sa=1&ei=CTOpW_2jO6nAjwT67rqACw&q=A2N0015C3KUU&oq=" & Cells(SearchRow, 1) & "&oq=A2N0015C3KUU&gs_l=img.12...0.0..1704...0.0..0.0.0.......1......gws-wiz-img.9wB6WwQJhwA"
Set objIE = New InternetExplorer
objIE.Visible = True
objIE.navigate url
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
For Each aEle In objIE.document.getElementsByTagName("IMG")
result = aEle
Sheets("Sheet1").Range(SearchRow & "C").Value = result
Sheets("Sheet1").Range(SearchRow & "D") = aEle.innerHTML
Sheets("Sheet1").Range(SearchRow & "F").Value = aEle.innerText
Debug.Print aEle.innerText
Next
Loop
'For i = 1 To lastRow
'url = "https://www.google.com/search?hl=en&biw=1600&bih=796&tbm=isch&sa=1&ei=CTOpW_2jO6nAjwT67rqACw&q=A2N0015C3KUU&oq=" & Cells(SearchRow, 1) & "&oq=A2N0015C3KUU&gs_l=img.12...0.0..1704...0.0..0.0.0.......1......gws-wiz-img.9wB6WwQJhwA"
Set HTMLdoc = objIE.document
Set imgElements = HTMLdoc.getElementsByTagName("IMG")
n = 1
For Each imgElement In imgElements
If InStr(ingElement.src, sImageSearchString) Then
If imgElement.ParentNode.nodeName = "A" Then
Set aElement = imgElement.ParentNode
If n = 2 Then
url2 = aElement.href 'imgElement.src
url3 = imgElement.src 'aElement.href
n = n + 1
End If
End If
End If
Next
Cells(SearchRow, 5) = url2
IE.Quit
Set IE = Nothing
End Sub
Notes on your code:
You need Option Explicit at the top of your code to check on variable declarations and typos amongst other advantages. There are a number of missing declarations e.g. result, and used ones later e.g. Set IE = CreateObject("InternetExplorer.Application"). You have two different variables (one late bound and one early) both creating IE instances. You only in fact use one.
Your current error may be down to you trying to work with an object here:
result = aEle which won't work without the Set keyword to provide the required reference.
Without example URLs and expected output it is difficult to advise on the later loops in your code. You appear to have a duplicate loop over IMG elements but this time with some restrictions. It is likely these loops can be merged.
An example:
The following uses an arbitrary concatenation in to pull the img src links in from search results based on A2N0015C3KUU.
It uses a CSS selector combination of #ires img[src] to target elements with img tags and src attributes within the parent element with id ires (search results).
It is to demonstrate the principle of gathering aNodeList of matching elements and writing out to a sheet. The querySelectorAll method applied the CSS selector combination to the HTMLDocument and returns the nodeList. The nodeList is looped along its .Length, with items accessed by index starting at 0.
Option Explicit
Public Sub GetInfo()
Dim IE As New InternetExplorer
With IE
.Visible = True
.navigate "https://www.google.com/search?hl=en&biw=1600&bih=796&tbm=isch&sa=1&ei=CTOpW_2jO6nAjwT67rqACw&q=A2N0015C3KUU&oq=1&%20%22&oq=A2N0015C3KUU&gs_l=img.12...0.0..1704...0.0..0.0.0.......1......gws-wiz-img.9wB6WwQJhwA"
While .Busy Or .readyState < 4: DoEvents: Wend
Dim aNodeList As Object, i As Long
Set aNodeList = IE.document.querySelectorAll("#ires img[src]")
For i = 0 To aNodeList.Length - 1
ActiveSheet.Cells(i + 2, 4) = aNodeList.item(i).src
Next
'Quit '<== Remember to quit application
End With
End Sub

web scraping using excel and VBA

i wrote my VBA code in excel sheet as below but it is not scrape data for me and also i don't know why please any one help me. it gave me reullt as "click her to read more" onlyi want to scrape enitre data such as first name last name state zip code and so on
Sub extractTablesData()
Dim IE As Object, obj As Object
Dim myState As String
Dim r As Integer, c As Integer, t As Integer
Dim elemCollection As Object
Set IE = CreateObject("InternetExplorer.Application")
myState = InputBox("Enter the city where you wish to work")
With IE
.Visible = True
.navigate ("http://www.funeralhomes.com/go/listing/Search? name=&city=&state=&country=USA&zip=&radius=")
While IE.readyState <> 4
DoEvents
Wend
For Each obj In IE.document.all.item("state").Options
If obj.innerText = myState Then
obj.Selected = True
End If
Next obj
IE.document.getElementsByValue("Search").item.Click
Do While IE.Busy: DoEvents: Loop
ThisWorkbook.Sheets("Sheet1").Range("A1:K1500").ClearContents
Set elemCollection = IE.document.getElementsByTagName("TABLE")
For t = 0 To (elemCollection.Length - 1)
For r = 0 To (elemCollection(t).Rows.Length - 1)
For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
ThisWorkbook.Worksheets(1).Cells(r + 1, c + 1) = elemCollection(t).Rows(r).Cells(c).innerText
Next c
Next r
Next t
End With
Set IE = Nothing
End Sub
Using the same URL as the answer already given you could alternatively select with CSS selectors to get the elements of interest, and use split to get just the names and address parts from the text. We can also do away with the browser altogether to get faster results from first results page.
Business name:
You can get the name with the following selector (using paid listing example):
div.paid-listing .listing-title
This selects (sample view)
Try
Address info:
The associated descriptive information can be retrieved with the selector:
div.paid-listing .address-summary
And then using split we can parse this into just the address information.
Code:
Option Explicit
Public Sub GetTitleAndAddress()
Dim oHtml As HTMLDocument, nodeList1 As Object, nodeList2 As Object, i As Long
Const URL As String = "http://www.funeralhomes.com/go/listing/ShowListing/USA/New%20York/New%20York"
Set oHtml = New HTMLDocument
With CreateObject("WINHTTP.WinHTTPRequest.5.1")
.Open "GET", URL, False
.send
oHtml.body.innerHTML = .responseText
End With
Set nodeList1 = oHtml.querySelectorAll("div.paid-listing .listing-title")
Set nodeList2 = oHtml.querySelectorAll("div.paid-listing .address-summary")
With Worksheets("Sheet3")
.UsedRange.ClearContents
For i = 0 To nodeList1.Length - 1
.Range("A" & i + 1) = nodeList1.Item(i).innerText
.Range("B" & i + 1) = Split(nodeList2.Item(i).innerText, Chr$(10))(0)
Next i
End With
End Sub
Example output:
Yeah, without an API, this can be very tricky at best, and very inconsistent at worst. For now, you can try the script below.
Sub DumpData()
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
URL = "http://www.funeralhomes.com/go/listing/ShowListing/USA/New%20York/New%20York"
'Wait for site to fully load
IE.Navigate2 URL
Do While IE.Busy = True
DoEvents
Loop
RowCount = 1
With Sheets("Sheet1")
.Cells.ClearContents
RowCount = 1
For Each itm In IE.document.all
If itm.classname Like "*free-listing*" Or itm.classname Like "*paid-listing*" Then
.Range("A" & RowCount) = itm.classname
.Range("B" & RowCount) = Left(itm.innertext, 1024)
RowCount = RowCount + 1
End If
Next itm
End With
End Sub
You probably want some kind of input box to capture the city and state and radius from the user, or capture those variable in cells in your worksheet.
Notice, the '%20' is a space character.
I got this idea from a friend of mine, Joel, a long time ago. That guy is great!

VBA web scraping

I am trying to get a row of data from this table on this website: http://www.nasdaq.com/symbol/neog/financials?query=balance-sheet
Now I can manage to get the "total liabilities" row using the
doc.getelementsbyclassname("net")(3).innertext
but I cannot figure out how to get any other rows of data such as common stock.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = Range("bscode").Row And _
Target.Column = Range("bscode").Column Then
Dim IE As New InternetExplorer
IE.Visible = True
IE.navigate "http://www.nasdaq.com/symbol/" & Range("bscode").Value & "/financials?query=balance-sheet&data=quarterly"
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
Dim sD As String
sD = Doc.getElementsByTagName("tr")(8).innerText
MsgBox sD
Dim aD As Variant
aD = Split(sD, "$")
Range("bs").Value = aD(1)
Range("ba").Value = aD(2)
Range("bb").Value = aD(3)
Range("bc").Value = aD(4)
End If
End Sub
If it helps, I have the HTML source and the tr highlighted that I want to grab.
screenshot of HTML code
The issue is the method of finding the table row data. Could someone please explain to me how to get other rows of data? It would be much appreciated !
I was able to do some trial and error and to get the correct reference this way:
Dim eTR As Object, cTR As Object, I as Integer 'I used object, because I did late binding
Set cTR = Doc.getElementsByTagName("tr")
i = 0
For Each eTR In cTR
If Left(eTR.innerText, 3) = "Com" Then
Debug.Print "(" & i; "): " & eTR.innerText
End If
i = i + 1
Next
The immediate window then displayed
(308): Common Stocks ... (a bunch of space) ...
$5,941$5,877$5,773$3,779
I then tested this statement:
sd = Doc.getElementsByTagName("tr")(308).innerText
Debug.Print sd
And got the same result.

Error Message as Object Required while using IE.Document.getElementById("info_window").innerText

I am very new to VBA programming & have been trying to capture the text that gets popup on the google map when I search using GPS Coordinates (Latitude and Longitude). I have been using the website www.gps-coordinates.net.
Till now I have been able to pass the GPS Coordinates to the website input boxes and got the button clicked and the address pops'up on the google map in a box. While I am trying to get the address from the box using IE.Document.getElementById("info_window").innerText, I get an error message
Runtime Error '424' Object Required
I am not able to understand which object the code is referring to. I have search the internet for a solution but couldn't find anyone facing similar kind of problem, so couldn't find a ready solution for this. The code snippet is mentioned below:
Sub GetPlaceName()
Dim btn As Variant
Dim IE As Object, Doc As Object
Dim sDD1 As String, sDD2 As String
Dim vAdd As Variant
Dim lat As Integer, longt As Integer, latrow As Integer, longrow As Integer
latrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row - 1
longrow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row - 1
If latrow <> longrow Then
MsgBox "The number of Latitudes & Longitudes are not equal. " & vbNewLine & " PleaseCheck...."
Else
Range("B2").Select
For i = 2 To latrow
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.navigate "http://www.gps-coordinates.net/"
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
Set Doc = IE.Document
Doc.getElementById("latitude").Value = Range("B" & i).Cells.Value
Doc.getElementById("longitude").Value = Range("C" & i).Cells.Value
With Doc
Set elems = .getElementsByTagName("button")
For Each e In elems
If e.getAttribute("onclick") = "codeLatLng(1)" Then
e.Click
Exit For
End If
Next e
End With
Do
DoEvents
Loop Until IE.ReadyState = READYSTATE_COMPLETE
sDD1 = IE.Document.getElementById("info_window").innerText
vAdd = Split(sDD1, vbNewLine)
Cells(i, "E").Value = vAdd
IE.Quit
Set IE = Nothing
Set Doc = Nothing
Next i
End If
End Sub
I believe that there must be a very small error which I am not able to figure out. It must also appear to be very silly to some of you but I really need help to fix this. Hope to receive reply soon... Thanks in advance :-)
Try using
Set IE = new SHDocVw.InternetExplorer
instead of
Set IE = CreateObject("InternetExplorer.Application")
this never failed to work for me.

Permission denied when trying to draw data from a table in IE

I have just recently started looking at applications of VBA in Excel accessing web pages through IE, and have no experience with html coding, so the solution to this might be really simple...
I have a section of code (below) that is supposed to navigate to a website, access a table and pull out the data into excel. However, at seemingly random times, for no reason that I can determine, the Object Variable 'TDelement' becomes locked somehow, and Excel throws up an Error 70: Permission Denied when I try to access the next cell through the loop. It doesn't happen all the time, and it doesn't happen on the same table cell.
Dim IE As Object
Dim TDElements As Object
Dim TDelement As Object
Dim Web_Address As String
Dim DteTm As Date
Web_Address = "http://www.bom.gov.au/fwo/IDQ65388/IDQ65388.040762.tbl.shtml"
' Access the Webpage
IE.Navigate Web_Address
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
' Find and Set Data Table Cells/object within webpage
Set TDElements = IE.document.GetElementsByTagName("td")
' Pull each TDElement (table cell) from TDElements
Rw = 1
Col = 2
For Each TDelement In TDElements
If Col = 1 Then
Col = 2
ElseIf Col = 2 Then
Col = 1
End If
If Col = 1 Then
DteTm = TDelement.innerText
Worksheets(1).Cells(Rw, Col).Value = DteTm
ElseIf Col = 2 Then
Worksheets(1).Cells(Rw, Col).Value = TDelement.innerText
End If
If Col = 2 Then
Rw = Rw + 1
End If
Next
If the error is going to occur within a cycle of the loop, it occurs on either
DteTm = TDelement.innerText or
Worksheets(1).Cells(Rw, Col).Value = TDelement.innerText,
dependant on the outcome of the If...Then statement, obviously.
After a bit of googling, the general concensus seemed to be that error 70 is related to naming conflicts with variables (ie trying to use the same variable name twice). Because of this I tried adding Set TDelement = Nothing before Next to clear the variable at the end of each loop, but it didn't resolve the issue (not all that surprising; I have never had an issue with variables in loops like this before).
Could it have something to do with .innerText? Even though it is mentioned on just about every forum post that I have seen with regards to pulling data from IE, it isn't mentioned in the Excel help files at all...
Any help on this would be greatly appreciated.
Try below code :
Sub sample()
Dim IE As Object
Dim Web_Address As String
Dim tblTR As Object
Dim tblTD As Object
Set IE = CreateObject("internetexplorer.application")
Web_Address = "http://www.bom.gov.au/fwo/IDQ65388/IDQ65388.040762.tbl.shtml"
' Access the Webpage
IE.Navigate Web_Address
IE.Visible = True
Start:
' Wait while IE loading...
Do While IE.Busy
Application.Wait DateAdd("s", 5, Now)
Loop
' Find and Set Data Table Cells/object within webpage
Set tblTR = IE.document.GetElementsByTagName("tr")
If tblTR Is Nothing Then GoTo Start
Dim i As Integer
i = 1
For Each tblTD In tblTR
If Not tblTD Is Nothing Then
Worksheets(1).Cells(i, 1).Value = tblTD.all(0).innerText
Worksheets(1).Cells(i, 2).Value = tblTD.all(1).innerText
End If
i = i + 1
Next
End Sub

Resources