CODEWITHSUNDEEP
excelvbaweb-scraping
Andrew Bishop
Andrew Bishop

Reputation: 37

Retrieving a URL from Internet Explorer with VBA

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

Upvotes: 2

Views: 3009

Answers (1)

QHarr
QHarr

Reputation: 84465

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

Upvotes: 1

Related Questions