FreeMapTools - vba to click show button

Alpacino

Well-known Member
Joined
Mar 16, 2011
Messages
511
Hi all

wonder if you can help. Im trying to set up a problem that will use freemaptool website to find distance between 2 postcodes.

however I need a command to click the "Show" button on the website and copy the value(distance) to my workbook.

any suggestions
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
This uses google maps to find distances between Zip Codes. It might be helpful for you.

Code:
Sub main()

Dim ZipcodeFrom As String
Dim ZipcodeTo As String
On Error Resume Next
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If Len(Cells(i, 1)) < 5 Then
        ZipcodeFrom = "0" & Cells(i, 1).Value
    Else
        ZipcodeFrom = Cells(i, 1).Value
    End If
    If Len(Cells(i, 2)) < 5 Then
        ZipcodeTo = "0" & Cells(i, 2).Value
    Else
        ZipcodeTo = Cells(i, 2).Value
    End If
    Cells(i, 3).Value = DriveTime(ZipcodeFrom, ZipcodeTo)
Next


End Sub




Function DriveTime(PointA As String, PointB As String)


  Dim myURL As String
  myURL = _
    "http://maps.google.com/maps?" & _
    "&q=from: " & PointA & " to: " & PointB


  Dim inet1 As Inet
  Dim mypage As Variant


  Set inet1 = New Inet
  With inet1
    .Protocol = icHTTP
    .URL = myURL
    mypage = .OpenURL(.URL, icString)
  End With
  Set inet1 = Nothing


  Dim intStart As Double, intEnd As Double
  intStart = InStr(mypage, "<div class=""altroute-rcol altroute-info"">") + 41
  intEnd = InStr(intStart, mypage, "</div>") - intStart
  DriveTime = Between_Ands(Mid(mypage, intStart, intEnd), "<span>", "mi")
  


End Function


Function Between_Ands(ByVal Full_String As String, ByVal First_Delimiter As String, ByVal Second_Delimiter As String) As String
Pos = InStr(Full_String, First_Delimiter)
pos2 = InStr(Full_String, Second_Delimiter)
If Pos = 0 Or pos2 = 0 Then
    Between_Ands = "Missing Delimiter"
    Exit Function
End If
Between_Ands = Mid(Full_String, Pos + Len(First_Delimiter), pos2 - (Pos + Len(First_Delimiter)))
End Function

This is the Output <style type="text/css"> table.tableizer-table {
border: 1px solid #CCC; font-family: Arial, Helvetica, sans-serif
font-size: 12px;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #ccc;
}
.tableizer-table th {
background-color: #104E8B;
color: #FFF;
font-weight: bold;
}
</style><table class="tableizer-table">
<tr class="tableizer-firstrow"><th>Zipcode From</th><th>Zipcode To</th><th>Distance</th></tr>
<tr><td>18201</td><td>06377</td><td>277</td></tr>
<tr><td>58078</td><td>02814</td><td>1,624</td></tr>
<tr><td>60624</td><td>03301</td><td>964</td></tr>
<tr><td>17406</td><td>08837</td><td>152</td></tr>
</table>
 
Upvote 0
This uses google maps to find distances between Zip Codes. It might be helpful for you.

Code:
Sub main()

Dim ZipcodeFrom As String
Dim ZipcodeTo As String
On Error Resume Next
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If Len(Cells(i, 1)) < 5 Then
        ZipcodeFrom = "0" & Cells(i, 1).Value
    Else
        ZipcodeFrom = Cells(i, 1).Value
    End If
    If Len(Cells(i, 2)) < 5 Then
        ZipcodeTo = "0" & Cells(i, 2).Value
    Else
        ZipcodeTo = Cells(i, 2).Value
    End If
    Cells(i, 3).Value = DriveTime(ZipcodeFrom, ZipcodeTo)
Next


End Sub




Function DriveTime(PointA As String, PointB As String)


  Dim myURL As String
  myURL = _
    "http://maps.google.com/maps?" & _
    "&q=from: " & PointA & " to: " & PointB


  Dim inet1 As Inet
  Dim mypage As Variant


  Set inet1 = New Inet
  With inet1
    .Protocol = icHTTP
    .URL = myURL
    mypage = .OpenURL(.URL, icString)
  End With
  Set inet1 = Nothing


  Dim intStart As Double, intEnd As Double
  intStart = InStr(mypage, "") + 41
  intEnd = InStr(intStart, mypage, "
") - intStart
  DriveTime = Between_Ands(Mid(mypage, intStart, intEnd), "", "mi")
  


End Function


Function Between_Ands(ByVal Full_String As String, ByVal First_Delimiter As String, ByVal Second_Delimiter As String) As String
Pos = InStr(Full_String, First_Delimiter)
pos2 = InStr(Full_String, Second_Delimiter)
If Pos = 0 Or pos2 = 0 Then
    Between_Ands = "Missing Delimiter"
    Exit Function
End If
Between_Ands = Mid(Full_String, Pos + Len(First_Delimiter), pos2 - (Pos + Len(First_Delimiter)))
End Function

This is the Output <style type="text/css"> table.tableizer-table {
border: 1px solid #CCC; font-family: Arial, Helvetica, sans-serif
font-size: 12px;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #ccc;
}
.tableizer-table th {
background-color: #104E8B;
color: #FFF;
font-weight: bold;
}
</style>





Zipcode FromZipcode ToDistance
1820106377277
58078028141,624
6062403301964
1740608837152

<tbody>
</tbody>


Im getting an an error with
Dim inet1 As Inet
Dim mypage As Variant




Set inet1 = New Inet
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,194
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top