Excel VB Mapquest

[luths6]

Hello,

I am very new to VB and excel. I am currently in a internship and am doing some distance calculations for shipping via road. I have a data set somewhere near 700 which if done by hand could be very time consuming. I have this current function that manages to open a instance of Internet explorer and calculate with Mapquest the driving distance between two points. The issue arises with pulling the distance from mapquest into its excel cell. I was wondering if anyone would take a look at it with me. I'm not sure where to go from here. Any help would be great. Thanks!

[luths6]

Actually.. I thought I had it figured out, but it ended up not working. I think the main issue is that Mapquest changed up their page. The original code I was working with was created for a much older Mapquest.

Public Function GetDistance(startAddr As String, startCity As String, _
  startState As String, startZip As String, endAddr As String, _
  endCity As String, endState As String, endZip As String) As String


Dim sURL As String
Dim appIE As InternetExplorer
Dim regex As RegExp, Regmatch As MatchCollection
Dim BodyTxt As String
Dim GetFirstPos As Long

sURL = "http://www.mapquest.com/maps?1c=" & Replace(startCity, " ", "+")
sURL = sURL & "&1s=" & startState & "&1a=" & Replace(startAddr, " ", "+")
sURL = sURL & "&1z=" & startZip & "&2c=" & endCity & "&2s=" & endState
sURL = sURL & "&2a=" & Replace(endAddr, " ", "+") & "&2z=" & endZip

Set appIE = New InternetExplorer
'Set appIE = CreateObject("Internetexplorer.application")

appIE.navigate sURL
appIE.Visible = True

    Do
        DoEvents
    Loop Until appIE.readyState = READYSTATE_COMPLETE

appIE.Refresh

Set regex = New RegExp
With regex
    Pattern = "Total Travel Estimates"
    MultiLine = False
End With

BodyTxt = appIE.document.Body.innerText
Set Regmatch = regex.Execute(BodyTxt)

If Regmatch.Count > 0 Then
    GetFirstPos = WorksheetFunction.Find("Total Travel Estimates", BodyTxt, 1)
    GetDistance1 = Mid(BodyTxt, GetFirstPos + 23, 100)
    GetDistance2 = Trim(Left(GetDistance1, InStr(GetDistance1, "Fuel Cost:") - 1))
    GetMiles = Trim(Right(GetDistance2, Len(GetDistance2) - InStr(GetDistance2, "/")))
    GetMiles2 = Val(Trim(Left(GetMiles, InStr(GetMiles, "miles") - 1)))
    GetTT = Trim(Left(GetDistance2, InStr(GetDistance2, "/") - 1))
    DoEvents
    GetDistance = GetMiles2
    Else
    GetDistance = "Address Error, fix and try again"
End If

appIE.Quit
Set appIE = Nothing
Set regex = Nothing
Set Regmatch = Nothing

End Function

[Leith Ross]

Hello luths6,

Welcome to the Forum!

It would help to see the original macro. Can you post it?

To Attach a File:

1. Scroll down to the window below your post Additional Options
2. In the frame Attach Files you will see the button Manage Attachments
3. Click the button.
4. A new window will open titled Manage Attachments - Excel Forum.
5. Click the Browse... button to locate your file for uploading.
6. This will open a new window File Upload.
7. Once you have located the file to upload click the Open button. This window will close.
8. You are now back in the Manage Attachments - Excel Forum window.
9. Click the Upload button and wait until the file has uploaded.
10. Close the window and then click Submit.

[luths6]

Thx. I posted an attachment.

[luths6]

I solved the problem. Mapquest updated to a new page for driving directions. The html changed enough to throw off the function I was working with. This function will pull driving time and distance from mapquest into your excel file. I needed to change the url being accessed to the classic mapquest.

Public Function GetDistance(startAddr As String, startCity As String, _
startState As String, startZip As String, endAddr As String, _
endCity As String, endState As String, endZip As String) As String

Application.EnableCancelKey = xlDisabled

Dim sURL As String
Dim appIE As InternetExplorer
Dim regex As RegExp, Regmatch As MatchCollection
Dim BodyTxt As String
Dim GetFirstPos As Long


Dim a, b, c As String




sURL = "http://classic.mapquest.com/maps?1c=" & Replace(startCity, " ", "+")
sURL = sURL & "&1s=" & startState & "&1a=" & Replace(startAddr, " ", "+")
sURL = sURL & "&1z=" & startZip & "&2c=" & endCity & "&2s=" & endState
sURL = sURL & "&2a=" & Replace(endAddr, " ", "+") & "&2z=" & endZip

Set appIE = New InternetExplorer
'Set appIE = CreateObject("Internetexplorer.application")

appIE.navigate sURL
appIE.Visible = True

Do

DoEvents

Loop Until appIE.readyState = READYSTATE_COMPLETE

appIE.Refresh

Set regex = New RegExp
With regex
Pattern = "Total Travel Estimates:"
MultiLine = False
End With


MsgBox "Loaded VBAX link"


BodyTxt = appIE.document.body.innerText

a = Right(BodyTxt, Len(BodyTxt) - InStr(BodyTxt, "Total Travel") + 1)

b = Left(a, Application.WorksheetFunction.Find("Fuel Cost:", a) - 1)
GetDistance = b


appIE.Quit
Set appIE = Nothing
Set regex = Nothing
Set Regmatch = Nothing

End Function