I have a common routine which does this, but it requires you create an account with the USPS to use their API. It uses XML format, so you need a reference to Microsoft MsXML library. It is run from VBA code in an Access database.
Here's the common code:
Code:
'
' Validate address with USPS
' returns valid address XML or error XML
'
' requires valid requester ID assigned by USPS
'
Public Function ValidateAddress(Address1 As String, Address2 As String, City As String, State As String, _
Optional Zip As String = "", Optional Zip4 As String = "") As String
Dim Doc As Object
Dim xhr As Object
Dim url As String
Dim request_xml As String
Dim isOK As Boolean
Set Doc = CreateObject("MSXML2.DOMDocument")
request_xml = "<AddressValidateRequest USERID=''><Address><Address1/><Address2/><City/><State/>" _
& "<Zip5/><Zip4/></Address></AddressValidateRequest>"
isOK = Doc.LoadXML(request_xml)
If isOK Then
With Doc.DocumentElement
.SelectSingleNode("//AddressValidateRequest").Attributes(0).Text = TempVars!UspsValidateId
.SelectSingleNode("//Address1").Text = Address1
.SelectSingleNode("//Address2").Text = Address2
.SelectSingleNode("//City").Text = City
.SelectSingleNode("//State").Text = State
.SelectSingleNode("//Zip5").Text = Zip
.SelectSingleNode("//Zip4").Text = Zip4
End With
Set xhr = CreateObject("Microsoft.XMLHTTP")
url = TempVars!UspsValidateBaseUrl & Doc.Xml
xhr.Open "GET", url, False
xhr.Send
'return response or error message
If xhr.Status = 200 Then
ValidateAddress = xhr.responseText
Else
ValidateAddress = xhr.Status & ": " & xhr.StatusText
End If
Set xhr = Nothing
Else
ValidateAddress = ""
End If
Set Doc = Nothing
End Function
This routine uses a temporary variable called TempVars!UspsValidateId, which was previously loaded with the USPS ID they supplied. You can store the ID, once obtained from USPS, in any way desired.
The routine returns XML text which is the reply from the USPS API.
Here is the code which calls the above function:
Code:
Private Sub validate_address()
Dim doc As Object
Dim nod As Object
Dim isOK As Boolean
Set doc = CreateObject("MSXML2.DOMDocument")
isOK = doc.LoadXML(ValidateAddress(Nz(Me.Address, ""), Nz(Me.Address2, ""), Nz(Me.City, ""), Nz(Me.State, ""), Nz(Me.Zip, ""), Nz(Me.Zip4, "")))
If isOK Then
With doc.DocumentElement
isOK = .SelectSingleNode("//Error") Is Nothing
If isOK Then
Set nod = .SelectSingleNode("//Address1")
If nod Is Nothing Then
Me.Address = Null
Else
Me.Address = nod.Text
End If
Set nod = .SelectSingleNode("//Address2")
If nod Is Nothing Then
Me.Address2 = Null
Else
Me.Address2 = nod.Text
End If
Set nod = .SelectSingleNode("//City")
If nod Is Nothing Then
Me.City = Null
Else
Me.City = nod.Text
End If
Set nod = .SelectSingleNode("//State")
If nod Is Nothing Then
Me.State = Null
Else
Me.State = nod.Text
End If
Set nod = .SelectSingleNode("//Zip5")
If nod Is Nothing Then
Me.Zip = Null
Else
Me.Zip = nod.Text
End If
Set nod = .SelectSingleNode("//Zip4")
If nod Is Nothing Then
Me.Zip4 = Null
Else
Me.Zip4 = nod.Text
End If
Me.UspsValidation = FilterByEnum.UspsValid
Else
MsgBox "Error validating address with USPS:" & vbCrLf & doc.DocumentElement.SelectSingleNode("//Description").Text
Me.UspsValidation = FilterByEnum.UspsInvalid
End If
End With
Else
MsgBox "Could not validate address with USPS." & vbCrLf & "Do you have an internet connection?", vbExclamation, "Error"
End If
Set doc = Nothing
Set nod = Nothing
End Sub
The line near the top shows with
blue where this subroutine calls the function.
The
orange lines show what my program does with the results depending on success or failure. You can do whatever you want instead.
There is no need to supply the zipcode to this routine, the zip and zip+4 fields are optional. This information will be supplied by (or corrected by) the USPS.
I'm not sure if this works perfectly running from Word VBA. It should, with a little bit of tinkering. Remember, if you put this code in a Word document, it will need to be saved as a Macro-Enabled document, with the extension "docm" instead of "docx".