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).