Check Remittance Vendor Address VBA Workaround

Following on from yesterdays post about the Undefined Symbol error, where I discovered that Microsoft have removed the link from the check remittance tables to PM Creditor Master, I thought it might be useful to post the VBA workaround used to get the creditor address.

The first step was to create five Calculated Fields on the Check Remittance report; for simplicity I named them CreditorAddress1 through CreditorAddress5. No separate field for Post (Zip) Code was created as addresses can be of all different lengths and I like to output tidy addresses where I can.

Once the fields were created and added to the report, in the Remittance Header section, they were selected and made available to Visual Basic.

Moving to the Visual Basic Editor there are several elements which needed to be created;

1. In the declarations at the top we add a declaration for the ADODB Connection;

Private madoConn As ADODB.Connection

2. In Report_Start we create the ADO Connection and set the DefaultDatabase to use (doing i there means it is only done once for the entire check remittance process);

Private Sub Report_Start()
       Set madoConn = UserInfoGet.CreateADOConnection
       madoConn.DefaultDatabase = UserInfoGet.IntercompanyID
End Sub

3. In Report_End we close the ADO connection;

Private Sub Report_End()
       If madoConn.State = adStateOpen Then madoConn.Close
       Set madoConn = Nothing
End Sub

4. The creditor address fields are part of the remittance header, so we need to add the code to get the data in Report_BeforeAH. In this subroutine there are calls to two other subroutines; mGetVendorAddressCode, which determines the address code being used for remittances, and mSetCreditorAddressFieldValues, which does the select using the Vendor ID and Vendor Address Code to get the address fields;

Private Sub Report_BeforeAH(ByVal Level As Integer, SuppressBand As Boolean)
       Dim adoRS               As ADODB.Recordset
       Dim strVendorID         As String
       Dim strVendorAddrCode   As String
 
       strVendorID = Trim(VendorID.Value)
       strVendorAddrCode = mGetVendorAddressCode(strVendorID)
 
       If Len(strVendorAddrCode) > 0 Then
              mSetCreditorAddressFieldValues strVendorID, strVendorAddrCode
       End If
 
End Sub
 
Private Function mGetVendorAddressCode(TheVendorID As String) As String
       Dim adoRS As ADODB.Recordset
 
       Set adoRS = New ADODB.Recordset
     
       adoRS.Open _
           "SELECT " & _
           "   VADDCDPR, " & _
           "   VADCDTRO " & _
           "FROM " & _
           "   PM00200 " & _
           "WHERE " & _
           "   VENDORID = '" & Replace(TheVendorID, "'", "''") & "'", _
           madoConn
     
       If adoRS.State = adStateOpen Then
              If Not (adoRS.BOF Or adoRS.EOF) Then
                     If Len(Trim(adoRS.Fields("VADCDTRO").Value)) > 0 Then
                            mGetVendorAddressCode = Trim(adoRS.Fields("VADCDTRO").Value)
                     Else
                            mGetVendorAddressCode = Trim(adoRS.Fields("VADDCDPR").Value)
                     End If
              End If
              adoRS.Close
       End If
     
       Set adoRS = Nothing
End Function
 
Private Sub mSetCreditorAddressFieldValues(TheVendorID As String, TheAddressCode As String)
       Dim adoRS As ADODB.Recordset
       Dim intAddressIndex As Integer
       Dim objFld As ADODB.Field
 
       Set adoRS = New ADODB.Recordset
     
       adoRS.Open _
              "SELECT " & _
                 "   RTRIM(ADDRESS1) AS ADDRESS1, " & _
                 "   RTRIM(ADDRESS2) AS ADDRESS2, " & _
                 "   RTRIM(ADDRESS3) AS ADDRESS3, " & _
                 "   RTRIM(CITY) AS CITY, " & _
                 "   RTRIM(STATE) AS STATE, " & _
                 "   RTRIM(ZIPCODE) AS ZIPCODE " & _
              "FROM " & _
                 "   PM00300 (nolock) " & _
              "WHERE " & _
                 "   VENDORID = '" & Replace(TheVendorID, "'", "''") & "' " & _
                 "   AND ADRSCODE = '" & Replace(TheAddressCode, "'", "''") & "' ", _
              madoConn
     
       intAddressIndex = 1
     
       If adoRS.State = adStateOpen Then
              If Not (adoRS.BOF Or adoRS.EOF) Then
                     For Each objFld In adoRS.Fields
                            If LenB(objFld.Value) > 0 Then
                                   CallByName(Me, "CreditorAddress" & intAddressIndex, VbGet).Value = objFld.Value
                                   intAddressIndex = intAddressIndex + 1
                                   If intAddressIndex = 6 Then Exit For
                            End If
                     Next
                     If intAddressIndex = 6 And LenB(adoRS.Fields("ZIPCODE").Value) > 0 Then
                            CreditorAddress5 = CreditorAddress5 & ", " & adoRS.Fields("ZIPCODE").Value
                     End If
              End If
              adoRS.Close
       End If
 
       Set adoRS = Nothing
End Sub

The mSetCreditorAddressFieldValues subroutine sets the address fields; if all six fields have been filled in the Zip Code is concatenated with the State field so the address only occupies five lines (this keeps it small enough that it is all visible through the window in the envelope).