Sub main()
Dim ZipcodeFrom As String
Dim ZipcodeTo As String
On Error Resume Next
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Len(Cells(i, 1)) < 5 Then
ZipcodeFrom = "0" & Cells(i, 1).Value
Else
ZipcodeFrom = Cells(i, 1).Value
End If
If Len(Cells(i, 2)) < 5 Then
ZipcodeTo = "0" & Cells(i, 2).Value
Else
ZipcodeTo = Cells(i, 2).Value
End If
Cells(i, 3).Value = DriveTime(ZipcodeFrom, ZipcodeTo)
Next
End Sub
Function DriveTime(PointA As String, PointB As String)
Dim myURL As String
myURL = _
"http://maps.google.com/maps?" & _
"&q=from: " & PointA & " to: " & PointB
Dim inet1 As Inet
Dim mypage As Variant
Set inet1 = New Inet
With inet1
.Protocol = icHTTP
.URL = myURL
mypage = .OpenURL(.URL, icString)
End With
Set inet1 = Nothing
Dim intStart As Double, intEnd As Double
intStart = InStr(mypage, "<div class=""altroute-rcol altroute-info"">") + 41
intEnd = InStr(intStart, mypage, "</div>") - intStart
DriveTime = Between_Ands(Mid(mypage, intStart, intEnd), "<span>", "mi")
End Function
Function Between_Ands(ByVal Full_String As String, ByVal First_Delimiter As String, ByVal Second_Delimiter As String) As String
Pos = InStr(Full_String, First_Delimiter)
pos2 = InStr(Full_String, Second_Delimiter)
If Pos = 0 Or pos2 = 0 Then
Between_Ands = "Missing Delimiter"
Exit Function
End If
Between_Ands = Mid(Full_String, Pos + Len(First_Delimiter), pos2 - (Pos + Len(First_Delimiter)))
End Function