Hi,
First off, thanks for posting this script and modifications. As
novice VBA scripter, they've been a huge help, without which I'd b
completely lost.
I've run into a wierd issue that I was hoping to get some help on
Unless I add a message box as highlighted below, the function return
#VALUE. Does anyone know why this may be, or hopefully, how to fix it
I'd like to be able to run the function without having to manually clic
the message box okay botton.
Thanks again,
Sam
Code
-------------------
' must set references to Microsoft VBScript Regular Expressions, Internet Controls
' & HTML Object Library before running this script
' based on
http://www.vbaexpress.com/kb/getarticle.php?kb_id=386
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
MsgBox "Loaded VBAX link"
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 = GetTT
Else
GetDistance = "Address Error, fix and try again"
End If
appIE.Quit
Set appIE = Nothing
Set regex = Nothing
Set Regmatch = Nothing
End Functio
-------------------
Paige;515130 said:
Thanks; I'll have to work with this a bit to make sure I don't mess an
of it
up!
ker_01 said:
Paige-
I had to change the search string in two places in the code (the tex string
it searches for on the Mapquest page has changed to "Total Travel
Estimates:"). I expanded the length of the returned string an usedtext
string commands (Instr, Left, Right, Trim, etc) to grab the parts.
With regex
.Pattern = "Total Travel Estimates:"
.MultiLine = False
End With
and
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, "Fue 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
So far, I'm just pulling milage and not the travel time, but it' there if
you need it.
If you still have problems, probably best to post your entire su with all
edits, and indicate which line the code is stopping on.
Best,
Keith