I have written some VBA code in Excel to retrieve the latitude and longitude from a Google Maps URL and paste it into a cell in my worksheet. My problem is in retrieving the URL from internet explorer. Below I have two examples of my code, one macro returns an about:blank as though the object doesn't have the LocationURL property, and the other example seems like it is saving all of my previous searches, so it cycles through all of my previous searches and pastes the very first searches' URL. Example 2 uses a shell suggestion that I found online to reassign the properties to the oIE object. I can get both to slightly work, but neither will do exactly what I need from the macro.
Cell(8,8) is a hyperlink to google maps where I'm searching an address, and Cell(8,9) is where I want to paste the URL after google maps has redirected and has the latitude and longitude in the URL.
Example 1:
Sub CommandButton1_Click()
Dim ie As Object
Dim Doc As HTMLDocument
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.Navigate "http://www.google.com/maps?q=" & Range("I7").Value
Do
DoEvents
Loop Until ie.ReadyState = 4
Set Doc = ie.Document
Cells(8, 9).Value = ie.LocationName
End Sub
Example 2:
Sub Macro()
Dim oIE, oShell, objShellWindows, strPath, X
strPath = Cells(8, 8)
Set oIE = CreateObject("InternetExplorer.Application")
'This is to resolve oIE.navigate "about:blank" issue
oIE.Top = 0
oIE.Left = 0
oIE.Width = 500
oIE.Height = 500
oIE.Navigate strPath
Do While oIE.Busy And oIE.ReadyState < 2
DoEvents
Loop
'Reassigning oIE.LocationName & vbCrLf & oIE.LocationURL values after redirect in IE
Set oShell = CreateObject("WScript.Shell")
Set objShellWindows = CreateObject("Shell.Application").Windows
For X = objShellWindows.Count - 1 To 0 Step -1
Set oIE = objShellWindows.Item(X)
If Not oIE Is Nothing Then
If StrComp(oIE.LocationURL, strPath, 1) = 0 Then
Do While oIE.Busy And oIE.ReadyState < 2
DoEvents
Loop
oIE.Visible = 2
Exit For
End If
End If
Cells(8, 9).Value = oIE.LocationURL
Set oIE = Nothing
Next
Set objShellWindows = Nothing
Set oIE = Nothing
End Sub
Thanks,
Andrew
Is this as simple as looping until the document.URL changes? In my timed loop I wait for the string safe=vss in the original page load to disappear.
Option Explicit
Public Sub GetNewURL()
Dim IE As New InternetExplorer, newURL As String, t As Date
Const MAX_WAIT_SEC As Long = 5
With IE
.Visible = True
.navigate2 "http://www.google.com/maps?q=" & "glasgow" '<==Range("I7").Value
While .Busy Or .readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
newURL = .document.URL
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While InStr(newURL, "safe=vss") > 0
Debug.Print newURL
End With
End Sub
Related
i am struggling on the following: I try to open an URL(Link), become redirected to a new URL and retrieve this new URL into a Cell in my excel worksheet.
I have written the following code but it is not retrieving the new URL and is not quitting the Internet Explorer at the end:
Sub Get_URL()
Dim ISIN As String
Dim Link As String
Dim IE As Object
ISIN = Range("A1").Value
Link = "https://www.finanzen.net/suchergebnis.asp?_search=" & ISIN
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate Link
End With
Range("A2") = IE.LocationURL
Set IE = Nothing
IE.Quit
End Sub
The ISIN in A1 is KYG875721634.
I would be very glad if some of you guys could find the problem. Thank you very much!
Greetings, Robin
This works. Read the comments please:
Sub Get_URL()
Dim ISIN As String
Dim Link As String
Dim IE As Object
'ISIN = Range("A1").Value
ISIN = "KYG875721634"
Link = "https://www.finanzen.net/suchergebnis.asp?_search=" & ISIN
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.Navigate Link
End With
'You must wait to load the page
Do While IE.readystate <> 4: DoEvents: Loop
'Range("A2") = IE.LocationURL
MsgBox IE.LocationURL
'First quit the IE
'because this step needs the reference ;-)
IE.Quit
Set IE = Nothing
End Sub
There're two issues in your code:
You need to add a wait to load page.
Do Until IE.readyState = 4
DoEvents
Loop
First quit IE. If you first set IE to Nothing then there will be no reference to IE when quit.
IE.Quit
Set IE = Nothing
The final code is like this which can work well:
Sub Get_URL()
Dim ISIN As String
Dim Link As String
Dim IE As Object
ISIN = Range("A1").Value
Link = "https://www.finanzen.net/suchergebnis.asp?_search=" & ISIN
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate Link
Do Until IE.readyState = 4
DoEvents
Loop
Range("A2") = IE.LocationURL
IE.Quit
Set IE = Nothing
End Sub
Result:
I'm dealing with a problem that's been dealt this before, but not in this situation.
I'm pulling addresses from the USPS website using VBA. When I place in my cell "ele.innertext" I get all of the innertext within the class, but VBA won't let me isolate the innertext to the item level - ele.item(1).innertext, for example, give me the above error. Do you know why?
My browser is IE11.
Relevant HTML:
<div id="zipByAddressDiv" class="industry-detail">Loading...</div>
<!-- start Handlebars template -->
<script id="zipByAddressTemplate" type="text/x-handlebars-template">
<ul class="list-group industry-detail">
{{#each addressList}}
<li class="list-group-item paginate">
<div class="zipcode-result-address">
<p>{{companyName}}</p>
<p>{{addressLine1}}</p>
<p>{{city}} {{state}} <strong>{{zip5}}-{{zip4}}</strong></p>
VBA:
Sub USPS()
Dim eRow As Long
Dim ele As Object
Dim objie As Object
Dim wscript As Object
Dim test As String
Dim testarray() As String
'Dim goods As Object
Dim r As Integer
Dim x As Long: x = 0
Dim vFacility As Variant
Dim y As Variant
'Dim IE As New InternetExplorer
Sheets("Address").Select
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Set objie = CreateObject("InternetExplorer.Application")
For r = 4 To 8
myaddress = Cells(r, 5).Value
mycity = Cells(r, 7).Value
mystate = Cells(r, 8).Value
myzipcode = Cells(r, 9).Value
'myaddress = Range("a2").Value
'mycity = Range("c2").Value
'mystate = Range("d2").Value
'myzipcode = Range("e2").Value
With objie
.Visible = True
.navigate "https://tools.usps.com/go/ZipLookupAction!input.action"
Do While .Busy
DoEvents
Loop
Set what = .document.getElementsByName("tAddress")
what.Item(0).Value = myaddress
Set zipcode = .document.getElementsByName("tCity")
zipcode.Item(0).Value = mycity
Set zipcode1 = .document.getElementsByName("tState")
zipcode1.Item(0).Value = mystate
Set zipcode2 = .document.getElementsByName("tZip-byaddress")
zipcode2.Item(0).Value = myzipcode
.document.getElementByID("zip-by-address").Click
Do While .Busy
DoEvents
Loop
For Each ele In .document.all
Select Case ele.className
Case "industry-detail"
test = ele.innertext
testarray = Split(test, vbCrLf)
Worksheets("Address").Cells(r, 11).Value = testarray(4)
'Debug.Print test
'Debug.Print "and"
'Debug.Print testarray(4)
End Select
Next ele
End With
Next r
Set objie = Nothing
Set ele = Nothing
Set IE = Nothing
'IE.Quit
End Sub
What I think you are trying to do is input address details and retrieve the found zipcode. This method uses CSS selectors to target the page styling and I start immediately with the address search URL. I use id selectors where possible (which is the same as saying .document.getElementById("yourID"), denoted by # as these are the quickest retrieval methods. When it comes to choosing state, which is a dropdown, I select the appropriate option. You could concantenate the search state 2 letter abbreviation into the option string e.g.
Dim state As String
state = "NY"
.querySelector("option[value=" & state & "]").Selected = True
There is a loop to ensure the target element is present in new search results page. I use another CSS selector of #zipByAddressDiv strong to target just the zipcode, which is in bold, in the results. The bold is set by the strong tag.
strong tag holding zipcode in result:
CSS query:
The above CSS selector is target by id using #zipByAddressDiv and then, rather than splitting into an array to get the value you want, it uses a descendant selector to target the strong tag element holding the required value.
VBA:
Option Explicit
Public Sub AddressSearch()
Dim IE As New InternetExplorer, t As Date, ele As Object
Const MAX_WAIT_SEC As Long = 5
With IE
.Visible = True
.navigate "https://tools.usps.com/zip-code-lookup.htm?byaddress"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
.querySelector("#tAddress").Value = "1 Main Street"
.querySelector("#tCity").Value = "New York"
.querySelector("option[value=NY]").Selected = True
' .querySelector("#tZip-byaddress").Value = 10045
.querySelector("#zip-by-address").Click
End With
While .Busy Or .readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
On Error Resume Next
Set ele = .document.querySelector("#zipByAddressDiv strong")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
Debug.Print ele.innerText
.Quit
End With
End Sub
Here is what that looks like in a loop:
Option Explicit
Public Sub AddressSearch()
Dim IE As New InternetExplorer, t As Date, ele As Object, i As Long
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Address")
Const MAX_WAIT_SEC As Long = 5
With IE
.Visible = True
For i = 4 To 8
.navigate "https://tools.usps.com/zip-code-lookup.htm?byaddress"
While .Busy Or .readyState < 4: DoEvents: Wend
With .document
.querySelector("#tAddress").Value = ws.Cells(i, 5).Value
.querySelector("#tCity").Value = ws.Cells(i, 7).Value
.querySelector("option[value=" & ws.Cells(i, 8).Value & "]").Selected = True
' .querySelector("#tZip-byaddress").Value = 10045
.querySelector("#zip-by-address").Click
End With
While .Busy Or .readyState < 4: DoEvents: Wend
t = Timer
Do
DoEvents
On Error Resume Next
Set ele = .document.querySelector("#zipByAddressDiv strong")
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ele Is Nothing
ws.Cells(i, 11) = ele.innerText
Set ele = Nothing
Next
.Quit
End With
End Sub
I have a VBA code that selects info from drop-down menus on a government website and then submits the query. The requested data then opens up in another IE page. I am trying to copy this data into excel; however, I am unable to do so.
My code currently copies the text on the first IE page that contains the drop-down menus. The government website is: http://www.osfi-bsif.gc.ca/Eng/wt-ow/Pages/FINDAT.aspx
I have look all over the internet for a solution but nothing seems to work...
Here is my code:
Sub GetOsfiFinancialData()
Dim UrlAddress As String
UrlAddress = "http://ws1.osfi-bsif.gc.ca/WebApps/FINDAT/DTIBanks.aspx?T=0&LANG=E"
Dim ie As Object
Set ie = CreateObject("internetexplorer.application")
With ie
.Silent = True
.Visible = False
.navigate UrlAddress
End With
Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop
Application.Wait (Now() + TimeValue("00:00:05"))
'Select Bank
ie.document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_institutionTypeCriteria_institutionsDropDownList").Value = Z005
'open window with financial data
Dim objButton
Set objButton = ie.document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_submitButton")
objButton.Focus
objButton.Click
'select new pop-up window
marker = 0
Set objshell = CreateObject("Shell.Application")
IE_count = objshell.Windows.Count
For x = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_title = objshell.Windows(x).document.Title
If my_title Like "Consolidated Monthly Balance Sheet" & "*" Then 'compare to find if the desired web page is already open
Set ie = objshell.Windows(x)
marker = 1
Exit For
Else
End If
Next
Do Until Not ie.Busy And ie.readyState = 4
DoEvents
Loop
Application.Wait (Now() + TimeValue("00:00:05"))
Dim doc As MSHTML.HTMLDocument
Dim tables As MSHTML.IHTMLElementCollection
Dim table As MSHTML.HTMLTable
Dim clipboard As MSForms.DataObject
Set doc = ie.document
Set tables = doc.getElementsByTagName("body")
Set table = tables(0)
Set clipboard = New MSForms.DataObject
'paste in sheets
Dim test
Set test = ActiveWorkbook.Sheets("Test")
clipboard.SetText table.outerHTML
clipboard.PutInClipboard
test.Range("A1").PasteSpecial xlPasteAll
clipboard.Clear
MsgBox ("Task Completed")
End Sub
Your help is greatly appreciated!
You were using the current test with document.Title. I found that For Each of all windows looking for the full title worked in combination with copy pasting the pop-up window outerHTML. No additional wait time was required.
Inside the For Each Loop, after you reset the IE instance to the new window, you can obtain the new URL with ie.document.url. As you already have the data loaded you might as well just copy paste it straight away in my opinion.
Code:
Option Explicit
Public Sub GetOsfiFinancialData()
Dim UrlAddress As String, objButton, ie As Object
UrlAddress = "http://ws1.osfi-bsif.gc.ca/WebApps/FINDAT/DTIBanks.aspx?T=0&LANG=E"
Set ie = CreateObject("internetexplorer.application")
With ie
.Silent = True
.Visible = False
.navigate UrlAddress
While .Busy Or .readyState < 4: DoEvents: Wend
.document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_institutionTypeCriteria_institutionsDropDownList").Value = "Z005"
Set objButton = .document.getElementById("DTIWebPartManager_gwpDTIBankControl1_DTIBankControl1_submitButton")
objButton.Focus
objButton.Click
Dim objShellWindows As New SHDocVw.ShellWindows, currentWindow As IWebBrowser2
For Each currentWindow In objShellWindows
If currentWindow.document.Title = "Consolidated Monthly Balance Sheet - Banks, Trust and Loan" Then
Set ie = currentWindow
Exit For
End If
Next
Dim clipboard As Object
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboard.SetText ie.document.body.outerHTML
clipboard.PutInClipboard
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial
.Quit
End With
End Sub
References (VBE > Tools > References):
Microsoft Internet Controls
I don't have time to get into all the stuff about controlling one browser from another, but I think you can figure that part out, especially since you made some great progress on this already. Get URL#2 from URL#1, like you are doing, but with some better data controls around it, and then do this...
Option Explicit
Sub Web_Table_Option_One()
Dim xml As Object
Dim html As Object
Dim objTable As Object
Dim result As String
Dim lRow As Long
Dim lngTable As Long
Dim lngRow As Long
Dim lngCol As Long
Dim ActRw As Long
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
With xml
.Open "GET", "http://ws1.osfi-bsif.gc.ca/WebApps/Temp/2f40b7ef-d024-4eca-a8a3-fb82153efafaFinancialData.aspx", False
.send
End With
result = xml.responseText
Set html = CreateObject("htmlfile")
html.body.innerHTML = result
Set objTable = html.getElementsByTagName("Table")
For lngTable = 0 To objTable.Length - 1
For lngRow = 0 To objTable(lngTable).Rows.Length - 1
For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
Next lngCol
Next lngRow
ActRw = ActRw + objTable(lngTable).Rows.Length + 1
Next lngTable
End Sub
I'm trying to click a button multiple times to get my page loaded fully. Webpage contains a button SHOW MORE instead of next page so in html coding behind the button remains same.
I am using the following excel-vba code to hit that button. It actually did click that button, but instead of showing the next results it shows the same result over and over again.
Could you please kindly show me how to make it right. Thanks in advance!
**' VARIABLE DECLARATION
Dim IE As Object
Dim county As String
Dim htmlDoc As Object
' CREATING OBJECT
Set IE = CreateObject("internetexplorer.application")
' WEBPAGE NAVIGATION
With IE
.navigate ("http://www.physiofirst.org.uk/find-physio/search-physio.html")
.Visible = True
End With
' WAITING FOR WEBPAGE TO LOAD
Do
DoEvents
Loop Until IE.readystate = 4
' SEARCHING ALL THE THE INDIVIDUAL STATE PHYSICIANS
Set htmlDoc = IE.document
Set searchbarvalue = htmlDoc.getelementsbyclassname("form-control mod-text-display")
i = 0
For Each classSearch In searchbarvalue
searchbarvalue(i).Value = "BRISTOL"
Next classSearch
While IE.busy
DoEvents
Wend
Set buttonclick = htmlDoc.getelementsbyclassname("btn btn-search")
i = 0
For Each buttonsearch In buttonclick
buttonclick(i).Click
Next buttonsearch
While IE.busy
DoEvents
Wend
Do
htmlDoc.getelementbyid("load-more-practice").Click
While IE.busy
DoEvents
Wend
Loop Until htmlDoc.getelementbyid("load-more-practice").Click = True
End Sub**
Try this code that Do Until data-page is = "1", because it starts on 2 and go to 1 when is completely loaded, with all Show More clicked.
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub test()
Dim IE As Object
Dim county As String
Dim htmlDoc As Object
Dim sURL As String
' CREATING OBJECT
Set IE = CreateObject("internetexplorer.application")
sURL = "http://www.physiofirst.org.uk/find-physio/search-physio.html"
' WEBPAGE NAVIGATION
With IE
.navigate (sURL)
.Visible = True
End With
WaitIE IE, 2000
' SEARCHING ALL THE THE INDIVIDUAL STATE PHYSICIANS
Set htmlDoc = IE.document
Set searchbarvalue = htmlDoc.getElementsByClassName("form-control mod-text-display")
i = 0
For Each classSearch In searchbarvalue
searchbarvalue(i).Value = "BRISTOL"
Next classSearch
WaitIE IE, 1000
Set buttonclick = htmlDoc.getElementsByClassName("btn btn-search")
buttonclick(0).Click
WaitIE IE, 1000
Set ShowMore = htmlDoc.getElementById("load-more-practice")
Do
ShowMore.Click
WaitIE IE, 2000
Loop Until ShowMore.getAttribute("data-page") = 1
'IE.Quit
'Set IE = Nothing
End Sub
Sub WaitIE(IE As Object, Optional time As Long = 250)
'Code from: https://stackoverflow.com/questions/33808000/run-time-error-91-object-variable-or-with-block-variable-not-set
Dim i As Long
Do
Sleep time
Debug.Print CStr(i) & vbTab & "Ready: " & CStr(IE.readyState = 4) & _
vbCrLf & vbTab & "Busy: " & CStr(IE.Busy)
i = i + 1
Loop Until IE.readyState = 4 Or Not IE.Busy
End Sub
I am absolutely new in webscraping and have some minor previous VBA knowledge.
I am trying to make a scraper which enters a site makes a search and then scrapes the details of the search.
I am very annoyed that my scraper can make the search with the given parameters, but after the search is made and the website is loaded, I make a innerHTML read request within VBA and the results are NOT the source code of the new page. So I cannot extract any information because my VBA code does not see the actual webpage html data. Why is that happening? What is the source code that my VBA extracts?
Thank you very much for your help in advance!
Public Sub my_scraper()
Dim my_data1, my_data2 As String
Dim my_Coll As String
i = 1
my_data1 = ActiveSheet.Cells(1, 1).Value
my_data2 = ActiveSheet.Cells(1, 2).Value
my_Coll = profession_hu_scraper(my_data1, my_data2)
Cells(2, 2).Value = my_Coll
End Sub
Public Function profession_hu_scraper(ByVal my_data1 As String, ByVal my_data2 As String) As String
Dim objIE As InternetExplorer
Dim html As HTMLDocument
Dim Link As Object
Dim ElementCol As Object
Dim erow As Long
'Dim all_inp_el As Object
'Application.ScreenUpdating = False
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Visible = True
.Navigate "https://www.profession.hu/"
Do While .ReadyState <> READYSTATE_COMPLETE
Application.StatusBar = "Loading website..."
DoEvents
Loop
Set html = .Document
Range("A16") = html.DocumentElement.innerHTML
.Document.getElementById("header_keyword").Value = my_data1
.Document.getElementById("header_location").Value = my_data2
Set my_classes = .Document.getElementsByClassName("p2_button_inner")
For Each my_class In my_classes
If my_class.getAttribute("value") = "Keresés" Then
Range("c4") = "Clicked"
my_class.Click
i = i + 1
End If
Next my_class
Do While .ReadyState <> READYSTATE_COMPLETE
Application.StatusBar = "Loading website..."
DoEvents
Loop
Set html = .Document
Range("B16") = html.DocumentElement.innerHTML
End With
Set objIE = Nothing
Application.StatusBar = "Finished"
'Application.StatusBar = ""
End Function
After a few days of struggling I finally was able to find out that the code works OK. The problem was that the max character of a cell is 32k so it could not show the whole html code.
If you are a beginner watch out for it!
Updated:
Public Function profession_Hu_Scraper(myData1 As String, my_data2 As String)
Dim ie As New InternetExplorer
Dim doc As HTMLDocument
Dim ws As Worksheet: Set ws = ActiveSheet
ie.navigate "https://www.profession.hu/"
Do While ie.readyState <> READYSTATE_COMPLETE
Loop
Set doc = ie.document
ws.Range("A16") = doc.getElementById(myData1).innerText
ws.Activate("B16") = doc.getElementById(mydata2).innerText
'whatever else you wish to do
End Function