Kal-El
12-14-2011, 07:19 PM
Evening, I was hoping someone might be able to help me with some code written by shred dude vbax.
It was working perfectly and then I went to test it today and I am getting an error
I have been trying to get help from others with absolutely no luck. I was all set to start using this and I am now for some reason getting this error
Runtime error '13'
Type Mismatch
When I select debug it takes me to
TgetGoogDistanceTime = CDbl(Left(TgetGoogDistanceTime, InStr(1, TgetGoogDistanceTime, " ") - 1))
The same error occurs for VgetGoogDistanceTime
I suspect it has to do with this section
Public Function getHTML(strURL As String) As String
'Returns the HTML code underlying a given URL
Dim oXH As Object
Set oXH = CreateObject("msxml2.xmlhttp")
With oXH
.Open "get", strURL, False
.send
getHTML = .responseText
End With
Set oXH = Nothing
End Function
But I am by no means experienced at all in this. C4 is one city, example Toronto,Canada and E4 would be Ottawa,Canada. in my speadsheet these are variable cells that get populated by different country,cities but for testing purposes a static "country,city" gives the same issue right now
C4 is one city example Toronto,Canada and E4 would be Ottawa,Canada
Option Explicit
'Google Maps Driving Times
'
' ########################################################################### #####
Sub MTSDistance2()
Dim dist1 As Double, time1 As Double
Dim dist2 As Double, time2 As Double
dist1 = TgetGoogDistanceTime(Range("C4"), Range("E4"), "distance")
time1 = TgetGoogDistanceTime(Range("C4"), Range("E4"), "time")
'
dist2 = VgetGoogDistanceTime(Range("C4"), Range("E4"), "distance")
time2 = VgetGoogDistanceTime(Range("C4"), Range("E4"), "time")
MsgBox "Time and Distance from " & Range("C4").Text & " to " & Range("E4").Text & ":" & Chr(10) & _
"Time = " & Format(Hour(time1), "00") & "h:" & Format(Minute(time1), "00") & "m" & Chr(10) & _
"Distance = " & Format(dist1 * 1.609344, "0.0") & " Km"
End Sub
' ########################################################################### #####
'Separate distance and time - text output
Public Function TgetGoogDistanceTime(rngSAdd As Range, rngEAdd As Range, Optional strReturn As String = "distance") As Variant
Dim i As Long
Dim sURL As String
Dim BodyTxt As String
Dim vUnits As Variant
Dim lngDiv As Long
Dim dblTemp As Double
sURL = "HHHP: // maps_google_com/maps?f=d&source=s_d" ( NOTE: REPLACE _ with "." and HHHP with HTTP)
sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
sURL = sURL & "&hl=en"
BodyTxt = getHTML(sURL)
If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
TgetGoogDistanceTime = "Error"
Else
TgetGoogDistanceTime = parseGoog(strReturn, BodyTxt)
If LCase(strReturn) Like "*time*" Then
vUnits = Split(TgetGoogDistanceTime)
For i = LBound(vUnits) To UBound(vUnits) - 1 Step 2
dblTemp = dblTemp + _
Val(vUnits(i)) / Choose(InStr(1, "hms", Left(vUnits(i + 1), 1), vbTextCompare), 24, 1440, 86400)
Next i
TgetGoogDistanceTime = dblTemp
Else
' TgetGoogDistanceTime = Val(TgetGoogDistanceTime)
TgetGoogDistanceTime = CDbl(Left(TgetGoogDistanceTime, InStr(1, TgetGoogDistanceTime, " ") - 1))
End If
End If
End Function
' ########################################################################### #####
'Separate distance and time - not text
'shred dude vbax
Public Function VgetGoogDistanceTime( _
rngSAdd As Range, _
rngEAdd As Range, _
Optional strReturn As String = "distance") _
As Variant
' =VGetGoogDistanceTime($A$1,$A$2,"time")
' coventry manchester 02:05
' =VGetGoogDistanceTime($A$1,$A$2,"distance")
' coventry manchester 116
Dim sURL As String
Dim BodyTxt As String
sURL = "HHHP: //maps_google_com/maps?f=d&source=s_d" ( NOTE: REPLACE _ with "." and HHHP with HTTP)
sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
sURL = sURL & "&hl=en"
BodyTxt = getHTML(sURL)
If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
VgetGoogDistanceTime = "Error"
Else
VgetGoogDistanceTime = parseGoog(strReturn, BodyTxt)
If LCase(strReturn) Like "*time*" Then
If InStr(1, VgetGoogDistanceTime, "hours", vbTextCompare) <> 0 Then
VgetGoogDistanceTime = Evaluate("""" & Replace(Replace(Replace(VgetGoogDistanceTime, " hours ", " hour "), " hour ", ":"), " mins", "") & ":0.0" & """+0")
Else
' VgetGoogDistanceTime = Val(VgetGoogDistanceTime)
VgetGoogDistanceTime = CDbl(Left(VgetGoogDistanceTime, InStr(1, VgetGoogDistanceTime, " ") - 1))
End If
Else
VgetGoogDistanceTime = CDbl(Left(VgetGoogDistanceTime, InStr(1, VgetGoogDistanceTime, " ") - 1))
End If
End If
End Function
' ########################################################################### #####
Public Function getHTML(strURL As String) As String
'Returns the HTML code underlying a given URL
Dim oXH As Object
Set oXH = CreateObject("msxml2.xmlhttp")
With oXH
.Open "get", strURL, False
.send
getHTML = .responseText
End With
Set oXH = Nothing
End Function
' ########################################################################### #####
Public Function parseGoog(strSearch As String, strHTML As String) As String
strSearch = "," & strSearch & ":'"
If InStr(1, strHTML, strSearch) = 0 Then
parseGoog = "Not Found"
Exit Function
Else
parseGoog = Mid(strHTML, InStr(1, strHTML, strSearch) + Len(strSearch))
parseGoog = Mid(parseGoog, 1, InStr(1, parseGoog, "'") - 1)
End If
End Function
' ########################################################################### ########################################
I would REALLY appreciate it if anyone could help me out here, I am absolutely at a loss.
Thanks in advance
It was working perfectly and then I went to test it today and I am getting an error
I have been trying to get help from others with absolutely no luck. I was all set to start using this and I am now for some reason getting this error
Runtime error '13'
Type Mismatch
When I select debug it takes me to
TgetGoogDistanceTime = CDbl(Left(TgetGoogDistanceTime, InStr(1, TgetGoogDistanceTime, " ") - 1))
The same error occurs for VgetGoogDistanceTime
I suspect it has to do with this section
Public Function getHTML(strURL As String) As String
'Returns the HTML code underlying a given URL
Dim oXH As Object
Set oXH = CreateObject("msxml2.xmlhttp")
With oXH
.Open "get", strURL, False
.send
getHTML = .responseText
End With
Set oXH = Nothing
End Function
But I am by no means experienced at all in this. C4 is one city, example Toronto,Canada and E4 would be Ottawa,Canada. in my speadsheet these are variable cells that get populated by different country,cities but for testing purposes a static "country,city" gives the same issue right now
C4 is one city example Toronto,Canada and E4 would be Ottawa,Canada
Option Explicit
'Google Maps Driving Times
'
' ########################################################################### #####
Sub MTSDistance2()
Dim dist1 As Double, time1 As Double
Dim dist2 As Double, time2 As Double
dist1 = TgetGoogDistanceTime(Range("C4"), Range("E4"), "distance")
time1 = TgetGoogDistanceTime(Range("C4"), Range("E4"), "time")
'
dist2 = VgetGoogDistanceTime(Range("C4"), Range("E4"), "distance")
time2 = VgetGoogDistanceTime(Range("C4"), Range("E4"), "time")
MsgBox "Time and Distance from " & Range("C4").Text & " to " & Range("E4").Text & ":" & Chr(10) & _
"Time = " & Format(Hour(time1), "00") & "h:" & Format(Minute(time1), "00") & "m" & Chr(10) & _
"Distance = " & Format(dist1 * 1.609344, "0.0") & " Km"
End Sub
' ########################################################################### #####
'Separate distance and time - text output
Public Function TgetGoogDistanceTime(rngSAdd As Range, rngEAdd As Range, Optional strReturn As String = "distance") As Variant
Dim i As Long
Dim sURL As String
Dim BodyTxt As String
Dim vUnits As Variant
Dim lngDiv As Long
Dim dblTemp As Double
sURL = "HHHP: // maps_google_com/maps?f=d&source=s_d" ( NOTE: REPLACE _ with "." and HHHP with HTTP)
sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
sURL = sURL & "&hl=en"
BodyTxt = getHTML(sURL)
If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
TgetGoogDistanceTime = "Error"
Else
TgetGoogDistanceTime = parseGoog(strReturn, BodyTxt)
If LCase(strReturn) Like "*time*" Then
vUnits = Split(TgetGoogDistanceTime)
For i = LBound(vUnits) To UBound(vUnits) - 1 Step 2
dblTemp = dblTemp + _
Val(vUnits(i)) / Choose(InStr(1, "hms", Left(vUnits(i + 1), 1), vbTextCompare), 24, 1440, 86400)
Next i
TgetGoogDistanceTime = dblTemp
Else
' TgetGoogDistanceTime = Val(TgetGoogDistanceTime)
TgetGoogDistanceTime = CDbl(Left(TgetGoogDistanceTime, InStr(1, TgetGoogDistanceTime, " ") - 1))
End If
End If
End Function
' ########################################################################### #####
'Separate distance and time - not text
'shred dude vbax
Public Function VgetGoogDistanceTime( _
rngSAdd As Range, _
rngEAdd As Range, _
Optional strReturn As String = "distance") _
As Variant
' =VGetGoogDistanceTime($A$1,$A$2,"time")
' coventry manchester 02:05
' =VGetGoogDistanceTime($A$1,$A$2,"distance")
' coventry manchester 116
Dim sURL As String
Dim BodyTxt As String
sURL = "HHHP: //maps_google_com/maps?f=d&source=s_d" ( NOTE: REPLACE _ with "." and HHHP with HTTP)
sURL = sURL & "&saddr=" & Replace(rngSAdd(1).Value, " ", "+")
sURL = sURL & "&daddr=" & Replace(rngEAdd(1).Value, " ", "+")
sURL = sURL & "&hl=en"
BodyTxt = getHTML(sURL)
If InStr(1, BodyTxt, strReturn, vbTextCompare) = 0 Then
VgetGoogDistanceTime = "Error"
Else
VgetGoogDistanceTime = parseGoog(strReturn, BodyTxt)
If LCase(strReturn) Like "*time*" Then
If InStr(1, VgetGoogDistanceTime, "hours", vbTextCompare) <> 0 Then
VgetGoogDistanceTime = Evaluate("""" & Replace(Replace(Replace(VgetGoogDistanceTime, " hours ", " hour "), " hour ", ":"), " mins", "") & ":0.0" & """+0")
Else
' VgetGoogDistanceTime = Val(VgetGoogDistanceTime)
VgetGoogDistanceTime = CDbl(Left(VgetGoogDistanceTime, InStr(1, VgetGoogDistanceTime, " ") - 1))
End If
Else
VgetGoogDistanceTime = CDbl(Left(VgetGoogDistanceTime, InStr(1, VgetGoogDistanceTime, " ") - 1))
End If
End If
End Function
' ########################################################################### #####
Public Function getHTML(strURL As String) As String
'Returns the HTML code underlying a given URL
Dim oXH As Object
Set oXH = CreateObject("msxml2.xmlhttp")
With oXH
.Open "get", strURL, False
.send
getHTML = .responseText
End With
Set oXH = Nothing
End Function
' ########################################################################### #####
Public Function parseGoog(strSearch As String, strHTML As String) As String
strSearch = "," & strSearch & ":'"
If InStr(1, strHTML, strSearch) = 0 Then
parseGoog = "Not Found"
Exit Function
Else
parseGoog = Mid(strHTML, InStr(1, strHTML, strSearch) + Len(strSearch))
parseGoog = Mid(parseGoog, 1, InStr(1, parseGoog, "'") - 1)
End If
End Function
' ########################################################################### ########################################
I would REALLY appreciate it if anyone could help me out here, I am absolutely at a loss.
Thanks in advance