Hallo,
Graag zou ik in onderstaand VBA script de mogelijkheid hebben om het aantal postcodeberekeningen te maximaliseren tot zeg 1000 berekeningen per dag.
Is dit mogelijk?
Option Explicit
Public Function GetPage(sLink As String) As XMLHTTP40
Dim oObj As MSXML2.XMLHTTP40
Set oObj = New XMLHTTP40
oObj.Open "GET", sLink, False
oObj.send ""
Set GetPage = oObj
End Function
Public Function GetDistanceBetweenAreaCodes(Code1 As String, Code2 As String)
Dim oResult As XMLHTTP40
Dim oDOM As DOMDocument40
Dim sStr As String
Dim sResult As String
Dim sURL As String
Const sKeyWords As String = "</strong> route over <strong>"
sURL = "http://route.anwb.nl/routeplanner/servlet/rp?action=0&zip1="
sURL = sURL & Code1 & "&city1=&street1=&zip2="
sURL = sURL & Code2 & "&city2=&street2=&iad=homepage.navigatie.middenkolom.routeplannerplanroute"
Set oResult = GetPage(sURL)
Set oDOM = New DOMDocument40
sStr = oResult.responseText
sResult = Mid(sStr, InStr(sStr, sKeyWords) + Len(sKeyWords))
sResult = Replace(Mid(sResult, 1, InStr(sResult, "m") - 1), ",", ".")
GetDistanceBetweenAreaCodes = Val(Left(sResult, Len(sResult) - 1)) * IIf(Right(sResult, 1) = "k", 1, 0.001)
End Function
Alvast bedankt voor het meedenken...
Fred
Graag zou ik in onderstaand VBA script de mogelijkheid hebben om het aantal postcodeberekeningen te maximaliseren tot zeg 1000 berekeningen per dag.
Is dit mogelijk?
Option Explicit
Public Function GetPage(sLink As String) As XMLHTTP40
Dim oObj As MSXML2.XMLHTTP40
Set oObj = New XMLHTTP40
oObj.Open "GET", sLink, False
oObj.send ""
Set GetPage = oObj
End Function
Public Function GetDistanceBetweenAreaCodes(Code1 As String, Code2 As String)
Dim oResult As XMLHTTP40
Dim oDOM As DOMDocument40
Dim sStr As String
Dim sResult As String
Dim sURL As String
Const sKeyWords As String = "</strong> route over <strong>"
sURL = "http://route.anwb.nl/routeplanner/servlet/rp?action=0&zip1="
sURL = sURL & Code1 & "&city1=&street1=&zip2="
sURL = sURL & Code2 & "&city2=&street2=&iad=homepage.navigatie.middenkolom.routeplannerplanroute"
Set oResult = GetPage(sURL)
Set oDOM = New DOMDocument40
sStr = oResult.responseText
sResult = Mid(sStr, InStr(sStr, sKeyWords) + Len(sKeyWords))
sResult = Replace(Mid(sResult, 1, InStr(sResult, "m") - 1), ",", ".")
GetDistanceBetweenAreaCodes = Val(Left(sResult, Len(sResult) - 1)) * IIf(Right(sResult, 1) = "k", 1, 0.001)
End Function
Alvast bedankt voor het meedenken...
Fred