(Seeking Code Examples) Enter Two Zips and Return Results from Webpage

[mrday0703]

Greetings,

I am looking to switch our current system of looking up mileage between 2 zip codes from Google Map's API to a DOD website (http://www.defensetravel.dod.mil/mobile/views/mileage/mileage.cfm)

As you can see, it takes both zips and does a 'as the crow flies' distance and provides the 'rate per mile'.

I am looking to incorporate this into an Excel Document where A1 is the 'From' and A2 is the 'To'. A3 will be the 'Calculated Distance' and A4 will be 'rate per mile'. (Example cells to make it easy)

I am a beginner when it comes to coding macros and whatnot so any guidance/example codes would be greatly appreciated.

Thank you for the support,

Matthew R Day
USMC

 

[hiker95]

mrday0703,

Welcome to the MrExcel forum.

See if the following will help you.

Distance between Zip Codes - Excel on a PC
https://desmondoshiwambo.wordpress.c...stance-in-vba/

 

[mrday0703]

Thank you for the welcome hiker95.

I reviewed the link but that is essentially what we are using now. We are trying to move away from Google's API and switch it to the DOD website since that is the 'official' way to calculate mileage.

 

[mrday0703]

This is where I'm at currently...The website loads, but errors out with the description of: 'Run-time error '-2147417848 (80010108)': Automation error. The object invoked has disconnected from its clients.

Sub test()
 Dim ie As SHDocVw.InternetExplorer
 Set ie = New SHDocVw.InternetExplorer
 ie.Visible = True
 ie.Navigate "[URL]http://www.defensetravel.dod.mil/mobile/views/mileage/mileage.cfm[/URL]"
 Do
 DoEvents
 Loop Until ie.readystate = 4
 Call ie.Document.GetElementByID("from").SetAttribute("value", "11234")
 Call ie.Document.GetElementByID("to").SetAttribute("value", "48074")
Set AllInputs = ie.Document.getelementsbytagname("mileage")
     For Each hyper_link In AllInputs
         If hyper_link.Name = "submit" Then
             hyper_link.Click
             Exit For
         End If
     Next
 Do
 DoEvents
 Loop Until ie.readystate = 3
 Do
 DoEvents
 Loop Until ie.readystate = 4
 End Sub

I am pulling the ElementID from the pages source.

This is where I'm at currently...The website loads, but errors out with the description of: 'Run-time error '-2147417848 (80010108)': Automation error. The object invoked has disconnected from its clients.

[CODE]Sub test()
Dim ie As SHDocVw.InternetExplorer
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.Navigate "[URL]http://www.defensetravel.dod.mil/mobile/views/mileage/mileage.cfm[/URL]"
Do
DoEvents
Loop Until ie.readystate = 4
Call ie.Document.GetElementByID("from").SetAttribute("value", "11234")
Call ie.Document.GetElementByID("to").SetAttribute("value", "48074")
Set AllInputs = ie.Document.getelementsbytagname("mileage")
    For Each hyper_link In AllInputs
        If hyper_link.Name = "submit" Then
            hyper_link.Click
            Exit For
        End If
    Next
Do
DoEvents
Loop Until ie.readystate = 3
Do
DoEvents
Loop Until ie.readystate = 4
End Sub

I am pulling the ElementID from the pages source.

div data-role="page" data-theme="b" id="mileage" style="min-height:100%"> 
  DTOD Mileage
 
  
  
   
    
     From:
     
    
    
     To:
     
    
    
    
     Round Trip:
           Off      On      
    
    
    
     Submit
     Reset

 

[mrday0703]

Disregard my last attempt to place HTML into a reply.../fail

I was able to get everything to work out after much trial and error. This script does work and populates the cells but I'm looking now to turn this large scale (ie large number of zip codes) and have each one update as they are entered.

I've looked up functions and that seems like the right direction but as to how to apply it I am unsure. Any assistance is appreciated.

Public Sub GetValue()
    Dim ie As Object
    Dim url As String
    Dim appIE As InternetExplorerMedium
    Dim objElement As Object
Set appIE = New InternetExplorerMedium
sURL = "[URL]http://www.defensetravel.dod.mil/mobile/views/mileage/mileage.cfm[/URL]"
With appIE
    .Navigate sURL
    .Visible = True
End With
Do While appIE.Busy Or appIE.ReadyState <> 4
    DoEvents
Loop
   appIE.Document.getElementById("from").Value = Range("A1")
   appIE.Document.getElementById("to").Value = Range("A2")
   appIE.Document.forms(0).submit
Do While appIE.Busy Or appIE.ReadyState <> 4
    DoEvents
    Loop
    
    Dim miles
Set miles = appIE.Document.getElementsByName("miles")(0)
Dim milesText
milesText = miles.Value
    
    Range("A3").Value = milesText
    
Dim cost
Set cost = appIE.Document.getElementsByName("milescost")(0)
Dim costText
costText = cost.Value
    
    Range("A4").Value = costText

Set appIE = Nothing
End Sub