Debug help

dantheram

Board Regular
Joined
Aug 27, 2010
Messages
192
Office Version
  1. 365
Platform
  1. Windows
Hi all,

i cannot debug this code, i suspect it's not pushing the postcodes into the website but it's giving me precious little feedback as to whats wrong - any ideas?

Code:
Sub Postcode_Distances()

Dim URL As String
Dim count As Integer
Dim waitCounter As Integer
Dim fromCheck As String
Dim toCheck As String
Dim explorerCounter As Integer
Dim resetExplorer As Integer
Dim waitTime As Integer ' seconds


count = 1
distance = 0
prevDistance = 0
prevdistance_direct = 0
waitTime = 2 'seconds
explorerCounter = 0
resetExplorer = 500 'restart explorer after this number of runs
URL = "http://www.freemaptools.com/distance-between-uk-postcodes.htm"


'get to webpage
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate2 URL
Do While IE.readyState <> 4 Or IE.busy = True
    DoEvents
Loop
        
' Read website information for inputting postcodes
Set form = IE.Document.getElementsByTagName("Form")
Set inputform = form.Item(0)
Set Postcodebox = inputform.Item(0)
Set Postcodebox2 = inputform.Item(1)
Set POSTCODEbutton = inputform.Item(2)
        
Worksheets("Postcodes").Range("A1").Select
Calculate


Do While Range("Postcode_From_Check").Offset(count, 0) <> ""


    fromCheck = Range("Postcode_From_Check").Offset(count, 0).Value
    toCheck = Range("Postcode_To_Check").Offset(count, 0).Value
    manualCheck = Range("Manual_Postcode_Check").Offset(count, 0).Value
    
    If fromCheck = "Invalid" Or toCheck = "Invalid" Or manualCheck = "Invalid" Then
        Range("Distance").Offset(count, 0) = "xxxx"
        Range("Distance_Direct").Offset(count, 0) = "xxxx"
    ElseIf Range("Distance").Offset(count, 0) = "" Then
        ' Read 'from' postcode - if valid use given postcode, otherwise use corrected version
        Range("Distance").Offset(count, 0).Select
        If fromCheck = "Valid" Then
            StartLocation = Range("Postcode_From").Offset(count, 0).Value
        Else
            StartLocation = fromCheck
        End If
        
        ' Read 'to' postcode - if valid use given postcode, otherwise use corrected version
        If toCheck = "Valid" Then
            EndLocation = Range("Postcode_To").Offset(count, 0).Value
        Else
            EndLocation = toCheck
        End If
        
        ' Input postcodes and 'click' button
        Postcodebox.Value = StartLocation
        Postcodebox2.Value = EndLocation
        POSTCODEbutton.Click


        ' Wait until website is ready (this step may not be necessary for freemaptools.com)
        DoEvents
        Do While IE.readyState <> 4 Or IE.busy = True
            DoEvents
        Loop
        
        'Pause for a second
        Application.Wait Time + TimeSerial(0, 0, waitTime)
        
        waitCounter = 0
        
        ' Read website information reading off distance information
        Set Table = IE.Document.getElementsByTagName("Table")
        Set DistanceTable = Table.Item(0)
        Set DistanceRow = DistanceTable.Rows.Item(5)
        Set DistanceElement = DistanceRow.Cells.Item(0).Children(1)
        Set DistanceRow_Direct = DistanceTable.Rows.Item(4)
        Set DistanceElement_Direct = DistanceRow_Direct.Cells.Item(0).Children(1)
        
        ' Take distance from website
        distance = Val(Trim(DistanceElement.Value))
        distance_direct = Val(Trim(DistanceElement_Direct.Value))
        
        Do While prevDistance = distance Or prevdistance_direct = distance_direct
            ' Read website information reading off distance information
            Set Table = IE.Document.getElementsByTagName("Table")
            Set DistanceTable = Table.Item(0)
            Set DistanceRow = DistanceTable.Rows.Item(5)
            Set DistanceElement = DistanceRow.Cells.Item(0).Children(1)
            Set DistanceRow_Direct = DistanceTable.Rows.Item(4)
            Set DistanceElement_Direct = DistanceRow_Direct.Cells.Item(0).Children(1)
            
            ' Take distance from website
            distance = Val(Trim(DistanceElement.Value))
            distance_direct = Val(Trim(DistanceElement_Direct.Value))
            waitCounter = waitCounter + 1
            
            ' If takes too long then enter message
            If waitCounter > 5 * 10 ^ 3 Then
                'errorCheck = Left(DistanceTable.Rows.Item(2).innertext, 5)
                Range("Distance").Offset(count, 0) = "as above?"
                Range("Distance_Direct").Offset(count, 0) = "as above?"
                Exit Do
            End If
        Loop
        prevDistance = distance
        prevdistance_direct = distance_direct
        Range("Distance").Offset(count, 0).Select
        If Selection <> "as above?" Then
            Selection = distance
            Range("Distance_Direct").Offset(count, 0) = distance_direct
        End If
        
        'Reset Explorer
        explorerCounter = explorerCounter + 1
        If explorerCounter >= resetExplorer Then
            IE.Quit
            Set IE = CreateObject("InternetExplorer.Application")
            IE.Visible = True


            'get to webpage
            IE.Navigate2 URL
            Do While IE.readyState <> 4 Or IE.busy = True
                DoEvents
            Loop


            ' Read website information for inputting postcodes
            Set form = IE.Document.getElementsByTagName("Form")
            Set inputform = form.Item(0)
            Set Postcodebox = inputform.Item(0)
            Set Postcodebox2 = inputform.Item(1)
            Set POSTCODEbutton = inputform.Item(2)
            explorerCounter = 0
            prevDistance = 0
            prevdistance_direct = 0
        End If
        
    End If
    
    count = count + 1
Loop


IE.Quit


End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
what line is it stopping on? whats the error you're getting?
 
Upvote 0
what line is it stopping on? whats the error you're getting?

this is the problem - there isnt one

It's running through to completion but returning 0 output - this is why i think its not filling in the form correctly / or at all
 
Upvote 0
when you step through it with F8, does it enter in the values into the boxes and submit the form at all?
 
Upvote 0
As you step through the code have you checked what's actually happening in IE?

Are postcodes being entered and submitted?

If they are, is anything being returned?
 
Upvote 0
As you step through the code have you checked what's actually happening in IE?

Are postcodes being entered and submitted?

If they are, is anything being returned?

nothing happens in IE - it loads, as expected, but nothing else. Interestingly, there is some interaction, as the map embeded on the web page goes from not showing major UK cities / seas to showing both - this occurs when the VBA steps over 'POSTCODEbutton.Click'
 
Upvote 0
What happens if instead of clicking the button to submit the form you submit it like this.
Code:
inputform .submit
 
Upvote 0
What happens if instead of clicking the button to submit the form you submit it like this.
Code:
inputform .submit

same thing - returns "as above" with no interaction with web page
 
Upvote 0
i think im having problems with objects not being defined .

I stripped it back and did a small test on the below and it worked, is the below what you expect the webpage to do?

reference for Microsoft Internet Controls needs to be added first.

Code:
Sub test()
'tools > references > Microsoft Interent Controls
Dim IE As New InternetExplorer
Dim inpt As Object, ieObj As Object, ieBtn As Object, btn As Object




IE.Visible = True
IE.Navigate "http://www.freemaptools.com/distance-between-uk-postcodes.htm"
Do While IE.ReadyState <> 4 Or IE.Busy = True
    DoEvents
Loop


Set inpt = IE.Document.getelementsbytagname("Input")


StartLocation = "Cr3 0BF"
EndLocation = "CR3 0EA"


For Each ieObj In inpt
If ieObj.Name = "pointa" Then ieObj.Value = StartLocation
If ieObj.Name = "pointb" Then ieObj.Value = EndLocation
Next
Set btn = IE.Document.getelementsbyclassname("fmtbutton")


For Each ieBtn In btn
If ieBtn.innertext = " Show " Then
ieBtn.Click
Exit For
End If
Next
'IE.Quit
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,170
Members
453,021
Latest member
Justyna P

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