Can this UK Postcode Lookup be converted from Access to Work with Excel

[vandango05]

I've found some code that looksup online UK postcodes and returns all matching addresses in an Access Form.

I wonder if it's possible to do something similar in Excel? Here is the example code from Access:

Option Compare Database

'Requires reference to WinHTTP.dll This can be found in 'C:\Windows\System32\'


Private Sub Text0_AfterUpdate()


    Me.List2.RowSource = ""
    Dim Pcode, sStr As String
    'First up, Format the postcode
    Pcode = UCase(Replace(Text0, " ", ""))
    Select Case Len(Pcode)
        Case 5
            Pcode = Mid(Pcode, 1, 2) & " " & Mid(Pcode, 3, 3)
        Case 6
            Pcode = Mid(Pcode, 1, 3) & " " & Mid(Pcode, 4, 3)
        Case 7
            Pcode = Mid(Pcode, 1, 4) & " " & Mid(Pcode, 5, 3)
    End Select
    
    'Now create the search string
    'http://www.192.com/places/ab/ab10-1/ab10-1an/
    sStr = "http://www.192.com/places/"
    For a = 1 To Len(Pcode)
        If IsNumeric(Mid(Pcode, a, 1)) Then
            sStr = sStr & Mid(Pcode, 1, a - 1) & "/"
            a = Len(Pcode)
        End If
    Next a
    sStr = sStr & Mid(Replace(Pcode, " ", "-"), 1, InStr(Pcode, " ") + 1) & "/"
    sStr = sStr & Replace(Pcode, " ", "-") & "/"
    
    'Now I create a WinHTTP request to get the information from the server
    
    Dim winReq As WinHttpRequest
    Dim HTM, Address As Variant
    Dim Add1, Add2, Add3, Add4 As String
    Dim sCount As Integer
    
    Set winReq = New WinHttpRequest
    With winReq
        .Open "GET", sStr, False
        .Send
        HTM = Split(Replace(.ResponseText, """", "'"), "<")
        If .Status <> 200 Then
            MsgBox ("Address not found")
            Exit Sub
        End If
    End With
    
    'Now I have the entire web page including tags just without the '<' at the beginning of each line
    'Split this down to find the address lines
    For Each i In HTM
        If InStr(i, "td class='address'>") > 0 Then
            'You can the assign the address to a listbox as below
            Me.List2.AddItem (Replace(i, "td class='address'>", ""))
            
            'Or you can split the address in to variables
            Address = Split((Replace(i, "td class='address'>", "")), ",")
            sCount = 0
            For Each j In Address
                sCount = sCount + 1
            Next
            Select Case sCount
                Case 3
                    Add1 = Address(0)
                    Add4 = Address(1)
                Case 4
                    Add1 = Address(0)
                    Add3 = Address(1)
                    Add4 = Address(2)
                Case 5
                    Add1 = Address(0)
                    Add2 = Address(1)
                    Add3 = Address(2)
                    Add4 = Address(3)
                Case 6
                    Add1 = Address(0) & " " & Address(1)
                    Add2 = Address(2)
                    Add3 = Address(3)
                    Add4 = Address(4)
            End Select
            'Put code here to assign these variables to anything you like
            
        End If
    Next
    
End Sub

Ideally a postcode could be entered in a specific cell then data fills into the cells below.

I've been searching forums and haven't found anything, wonder if anyone could help?

 

[Andrew Poulsom]

Sure:

https://app.box.com/s/cdhazmme0gbrxb5cqvw9

 

[vandango05]

Andrew you are a legend! Thank you for all of your help.

 

[vandango05]

Hi Andrew, not sure if you'll remember this post, however about a year ago you very kindly helped with a very useful function to return a full address from a UK postocode. Here is the code:

Option Explicit

Function GetAddress(Postcode As String)
  
    Dim sStr As String
    Dim a As Long
    Dim winReq As WinHttpRequest
    Dim HTM As Variant, Address As Variant
    Dim i As Variant
    Dim j As Variant
    Dim sCount As Integer
'   Format the postcode
    Select Case Len(Postcode)
        Case 5
            Postcode = Mid(Postcode, 1, 2) & " " & Mid(Postcode, 3, 3)
        Case 6
            Postcode = Mid(Postcode, 1, 3) & " " & Mid(Postcode, 4, 3)
        Case 7
            Postcode = Mid(Postcode, 1, 4) & " " & Mid(Postcode, 5, 3)
    End Select
'   Now create the search string
    sStr = "http://www.192.com/places/"
    For a = 1 To Len(Postcode)
        If IsNumeric(Mid(Postcode, a, 1)) Then
            sStr = sStr & Mid(Postcode, 1, a - 1) & "/"
            a = Len(Postcode)
        End If
    Next a
    sStr = sStr & Mid(Replace(Postcode, " ", "-"), 1, InStr(Postcode, " ") + 1) & "/"
    sStr = sStr & Replace(Postcode, " ", "-") & "/"
'   Now create a WinHTTP request to get the information from the server
    Set winReq = New WinHttpRequest
    With winReq
        .Open "GET", sStr, False
        .Send
        HTM = Split(Replace(.ResponseText, """", "'"), "<")
        If .Status <> 200 Then
            GetAddress = "Address not found"
            Exit Function
        End If
    End With
'   Now I have the entire web page including tags just without the '<' at the beginning of each line
'   Split this down to find the address lines
    For Each i In HTM
        If InStr(i, "td class='address'>") > 0 Then
'           Split the address in to variables
            Address = Split((Replace(i, "td class='address'>", "")), ",")
            sCount = 0
            For Each j In Address
                sCount = sCount + 1
            Next
            Select Case sCount
                Case 3
                    GetAddress = Address(0) & "," & Address(1)
                Case 4
                    GetAddress = Address(0) & "," & Address(1) & "," & Address(2)
                Case 5
                    GetAddress = Address(0) & "," & Address(1) & "," & Address(2) & "," & Address(3)
                Case 6
                    GetAddress = Address(0) & "," & Address(1) & "," & Address(2) & "," & Address(3) & "," & Address(4)
                
            End Select
        End If
        
    Next i
End Function

It's been working great for the past year, but has recently stopped working. I was thinking that the website may have changed the web address so it differs to the address generated by your code, but it appears to be the same so i'm a bit stumped. Any ideas?

 

[Andrew Poulsom]

In the VBA code replace both occurrences of:

td class='address'>

with:

div class='address'>

 

[vandango05]

Perfect, thank you!