Printable Version of Topic

Click here to view this topic in its original format

UtterAccess Forums _ Access Macros _ Access Vba To Lookup + 4 Zip Code

Posted by: chalupabatman Mar 13 2020, 11:59 AM

Does anyone have a VBA function that will look-up the plus-4 zip code if we pass in the address, city, state, and zip?

Posted by: DanielPineault Mar 13 2020, 12:26 PM

Have you Googled, there are many threads about this. For instance the following looks promising, see: https://answers.microsoft.com/en-us/msoffice/forum/all/get-zip-code-function-in-vba/05eb0693-0463-4d02-bac7-0165869a1260

Posted by: chalupabatman Mar 13 2020, 02:02 PM

I've seen several threads, but wasn't sure if any of them were any good. I always like to ask if someone has used it in say the past 12 months to know if it still works smile.gif

Posted by: chalupabatman Mar 13 2020, 04:42 PM

@DanielPineault - this isn't working for me...

This is what I have

CODE
Function Test()
    ZipCode "13675 Coursey Blvd Apt 1534, Baton Rouge, LA"
End Function
Function ZipCode(Addr1 As String) As String
' Uses USPS website to retrieve 9-digit zipcode
' Takes much longer than Google, but it returns 9 digit zipcode instead of the 5 digit zipcode
    Dim URL As String
    Dim AD As String
    Dim Ct As String
    Dim St As String
    Dim Data As String
    Dim Addr As String
    Dim Zip As String
    Dim I As Integer
    Dim ie As Object
    Dim ieDoc As Object
  
    Addr = Trim(Addr1)
    I = InStr(1, Addr, ", ")
    If I > 0 Then Addr = Right(Addr, Len(Addr) - I - 1)
    Addr = Addr & ", CA"
  
    I = InStr(1, Addr, ";")
    AD = Replace(Trim(Left(Addr, I - 1)), " ", "+")
    Ct = Replace(Trim(Right(Addr, Len(Addr) - I - 1)), " ", "+")
  
    URL = "https://tools.usps.com/go/ZipLookupResultsAction!input.action?resultMode=0&companyName=&address1="
    URL = URL & AD & "&address2=&city=" & Ct & "&state=" & St & "&urbanCode=&postalCode=&zip="
  
    Set ie = CreateObject("InternetExplorer.Application")
    ie.navigate URL
  
    Do Until (ie.ReadyState = 4 And Not ie.Busy)
        DoEvents
    Loop
  
    Set ieDoc = ie.Document
    Data = ieDoc.body.innerText
    Data = Right(Data, Len(Data) - 2400)
    If InStr(1, Data, "Unfortunately, this address wasn't found") > 0 Then
        ZipCode = "Zipcode Error"
    Else
        Data = Mid(Data, InStr(1, Data, "Here's the full address") + 94, 100)
        ZipCode = Mid(Data, InStr(1, Data, "-") - 5, 10)
    End If
    Set ie = Nothing
    Set ieDoc = Nothing
End Function



But when the code hits this line
CODE
AD = Replace(Trim(Left(Addr, I - 1)), " ", "+")


I get this error ->
Invalid procedure call or argument.