Distances betwteen two zip codes

**cadamhill** · 12-20-2012, 05:18 PM

I am looking for a way to reference a zip code of a customer on my estimate sheet against the zip code I life in to determine the approximate distance of the job. Thanks for any help in advance.

**stnkynts** · 12-20-2012, 06:12 PM

You would probably need to have a helper sheet with each zip code listed and the approximate distance from where you live. You could then use a lookup function to display it on your estimate sheet.

**cadamhill** · 12-21-2012, 11:45 AM

Do you think there is a way to do this using a reference through google maps/earth or mapquest?

**Chippy** · 12-21-2012, 01:21 PM

This function uses Google Maps (not the API) and returns the distance between 2 addresses. It can called from VBA or as a worksheet cell function. For example with the start address in A1 and the end address in B1, in C1 enter =GMaps_Distance(A1,B1). The addresses can be any address, location, latitude and longitude coordinates, zip code, post code, etc.

Public Function GMaps_Distance(FromAddress As String, ToAddress As String) As String

    Static XML As Object
    Dim URL As String
    Dim HTMLdoc As Object
    Dim routeLI As Object

    URL = "http://maps.google.com/maps?f=d&source=s_d&saddr=" & Escape(FromAddress) & "&daddr=" & Escape(ToAddress)
    
    If XML Is Nothing Then Set XML = CreateObject("MSXML2.XMLHTTP")
    With XML
        .Open "GET", URL, False
        .send
        Set HTMLdoc = New HTMLDocument
        HTMLdoc.body.innerHTML = .responseText
    End With
        
    GMaps_Distance = ""
    Set routeLI = HTMLdoc.getElementById("altroute_0")
    If Not routeLI Is Nothing Then
        GMaps_Distance = Left(routeLI.innerText, InStr(routeLI.innerText, ", ") - 1)
    End If

End Function


Private Function Escape(ByVal paramValue As String) As String

    Dim i As Integer, BadChars As String

    BadChars = "<>%=&!@#$^()+{[}]|\;:'"",/?"
    For i = 1 To Len(BadChars)
        paramValue = Replace(paramValue, Mid(BadChars, i, 1), "%" & Hex(Asc(Mid(BadChars, i, 1))))
    Next
    paramValue = Replace(paramValue, " ", "+")
    Escape = paramValue

End Function

**cadamhill** · 12-21-2012, 03:01 PM

The macro seems to get hinged up at

Set HTMLdoc = New HTMLDocument

Any suggestions?

**Chippy** · 12-21-2012, 03:26 PM

Oops! Change that line to:

        Set HTMLdoc = CreateObject("HTMLFile")

**cadamhill** · 12-21-2012, 04:19 PM

There is still an issue. not sure where. Do you mind taking another look? Thanks. Merry Christmas everyone.

**Chippy** · 12-22-2012, 07:13 AM

What is the issue? Does it display an error? Is the distance returned blank or incorrect? Here is the complete code again, including a test routine which displays "2,764 mi" for me.

Sub Test_Distance()
    'Microsoft HQ to White House
    MsgBox GMaps_Distance("98052", "20500")
End Sub


Public Function GMaps_Distance(FromAddress As String, ToAddress As String) As String

    Static XML As Object
    Dim URL As String
    Dim HTMLdoc As Object
    Dim routeLI As Object

    URL = "http://maps.google.com/maps?f=d&source=s_d&saddr=" & Escape(FromAddress) & "&daddr=" & Escape(ToAddress)
    
    If XML Is Nothing Then Set XML = CreateObject("MSXML2.XMLHTTP")
    With XML
        .Open "GET", URL, False
        .send
        Set HTMLdoc = CreateObject("HTMLFile")
        HTMLdoc.body.innerHTML = .responseText
    End With
        
    GMaps_Distance = ""
    Set routeLI = HTMLdoc.getElementById("altroute_0")
    If Not routeLI Is Nothing Then
        GMaps_Distance = Left(routeLI.innerText, InStr(routeLI.innerText, ", ") - 1)
    End If

End Function


Private Function Escape(ByVal paramValue As String) As String

    Dim i As Integer, BadChars As String

    BadChars = "<>%=&!@#$^()+{[}]|\;:'"",/?"
    For i = 1 To Len(BadChars)
        paramValue = Replace(paramValue, Mid(BadChars, i, 1), "%" & Hex(Asc(Mid(BadChars, i, 1))))
    Next
    paramValue = Replace(paramValue, " ", "+")
    Escape = paramValue

End Function

If the distance returned is blank, it means that id=altroute_0 doesn't exist in the Google Maps web page when the code is run in USA, so you will have to examine the HTML source to find the correct id and maybe modify that part of the code slightly.