Using Excel VBA to Open and Autofill Web Pages

This post is more about manipulating web pages than creating them.

My employer had a 2007 excel spreadsheet that they used to track several hundred projects. They would open a browser then copy/paste the information into a modified Google map. My boss asked me if there was a way I could automate this process.

I found parts to the solution here and there. I hope this will help someone else. It was a fun challenge and led to other similiar projects. Please remember, I am not a professional programmer so feel free to add better suggestions to comments.

Since the actual project cannot be duplicated here let’s just say we have a spreadsheet with a customer’s Name, Address, City, State and Zip. We want to send that information to Google and see the map.

Click here to download the example created in 2007 and saved as xls: http://www.webdebris.com/test/GetMapExample.zip

First thing I will need is a button. Switching over to the developer tab I add an active X button and call it GetMap. Adding it above the header, which can be froze, will let the button be available always.

Next I need to add a reference to Microsoft’s web browser to the excel spreadsheet. In the visual basic editor, go to Tools References and add Microsoft Internet Controls.

Now it is time to start coding.

Option Explicit

Public ie As Object

Public strAddress As String 'Builds the address to send to Google

'The following line will let the code sleep while waiting for the page to load
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
'When working in excel the browser will stay in the background. This will bring the browser to the top
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long

Private Sub GetMap_Click()

'There is a bug/feature with Excel that when the IE window closes the ie object still has a reference.
'Normally you would check for the IE window to close and then set the reference to nothing.
'Web Control does not have an on_quit event. So you have to trap by error.
On Error GoTo ErrHandle:

  Dim strCursorLocation As String 'The location of the cursor when the button was clicked
  Dim strRow As String 'Will hold the row number
  Dim i As Integer

  strCursorLocation = ActiveCell.Address(False, False) 'Get the current cursor location
  strRow = ""
  
  'Remove letters from strCursorLocation
  For i = 1 To Len(strCursorLocation)
  
    If IsNumeric(Mid(strCursorLocation, i, 1)) Then
        
            strRow = strRow & Mid(strCursorLocation, i, 1)
            
    End If
    
  Next i

  'Build the address by adding columns B thru E
  strAddress = Range("B" + strRow).Value + " "
  strAddress = strAddress + Range("C" + strRow).Value + " "
  strAddress = strAddress + Range("D" + strRow).Value + " "
  strAddress = strAddress + Range("E" + strRow).Value + " "

  'Check to see if an IE window has been opened
  If ie Is Nothing Then

    Call OpenGoogle

  End If

  'Bring IE to top. Does not bring to top 100 percent of the time.
  If Not ie Is Nothing Then

    BringWindowToTop (ie.hwnd)

  End If

  Call EnterAddress

  Exit Sub

ErrHandle:

  'Reopen IE window if it was closed
  If Err.Number = -2147417848 Or Err.Number = 462 Then

    Call OpenGoogle
    Resume
    
  Else

    'Something else has happened
    MsgBox "Error: " + CStr(Err.Number) + " " + Err.Description, vbCritical
    
  End If
    
End Sub

Private Sub OpenGoogle()

  'Create IE Window
  Set ie = CreateObject("Internetexplorer.Application")
  'Show IE Window
  ie.Visible = True
  'Navigate to the google map page
  ie.Navigate "http://maps.google.com/maps?hl=en&tab=wl"

  'Wait for the page to load
  Do While ie.Busy = True

    DoEvents
    Sleep 500

  Loop

End Sub

Private Sub EnterAddress()

  'Check to see if map page was navigated away from
  If ie.document.URL <> "http://maps.google.com/maps?hl=en&tab=wl" Then
    
    'Reload map page
    ie.Navigate "http://maps.google.com/maps?hl=en&tab=wl"

    'Wait for the page to load
    Do While ie.Busy = True

      DoEvents
      Sleep 500

    Loop

  End If

  With ie

    .document.all("q_d").Value = strAddress  'enter the address
    .document.all("q-sub").Click  'click the search button
    
  End With

End Sub