PMTPOST01 Import AP Payment Batch

Public strFileName, strPostingDate, parsed_line As String
Public booNewHeader As Boolean
Public intPostYear, intPostMonth, intPostDay As Integer
Public intRecordCount, intRowsProcessed As Integer
Public PaymentArray() As String

Sub MainSub()
'
' Sage 300 Macro file: \\SAPP002\Sage\Sage 300 ERP\Macros\PMTPOST01.AVB
' Recorded at: Mon Jul 02 15:56:48 2018
'


On Error GoTo ACCPACErrorHandler
frmInvoiceOpen.Show
If VBA.Len(strFileName) = 0 Then
   MsgBox "No file specified. Program exiting without import"
   End
End If

'    MsgBox "File Name = " + strFileName + VBA.Chr(13) + "Posting Date = " + strPostingDate
intPostYear = VBA.Val(VBA.Left(strPostingDate, 4))
intPostMonth = VBA.Val(VBA.Mid(strPostingDate, 5, 2))
intPostDay = VBA.Val(VBA.Right(strPostingDate, 2))


TransformInputFile
CreateBatch
MsgBox VBA.Format(intRowsProcessed, "#,###") + " Records were processed.", vbOKOnly

Exit Sub

ACCPACErrorHandler:
  Dim lCount As Long
  Dim lIndex As Long

  If Errors Is Nothing Then
       MsgBox Err.Description
  Else
      lCount = Errors.Count

      If lCount = 0 Then
          MsgBox Err.Description
      Else
          For lIndex = 0 To lCount - 1
              MsgBox Errors.Item(lIndex)
          Next
          Errors.Clear

      End If
      Resume Next

  End If
Close All

End Sub

Sub TransformInputFile()

Dim file_name As String
Dim fnum As Integer
Dim whole_file As String
Dim lines As Variant
Dim first_line() As Variant
Dim raw_line As String
Dim one_line() As String
Dim num_rows As Long
Dim num_cols As Long
Dim r As Long
Dim C As Long

    file_name = strFileName

    ' Load the file.
    fnum = FreeFile()
    Open file_name For Input As fnum
    whole_file = Input$(LOF(fnum), #fnum)
    Close fnum

    ' Break the file into lines.
    lines = Split(whole_file, vbCrLf)

    ' Dimension the array.
    num_rows = UBound(lines) - 1
    num_cols = 24
    ReDim PaymentArray(num_rows, num_cols)
    intRecordCount = UBound(lines) - 1

    ' Copy the data into the array.
    For r = 1 To num_rows
        If Len(lines(r)) > 0 Then
            raw_line = lines(r)
            ParseLine (raw_line)
            one_line = Split(parsed_line, "|")
            For C = 0 To num_cols
                If IsNull(one_line(C)) Then
                    PaymentArray(r, C) = ""
                Else
                    PaymentArray(r, C) = one_line(C)
                End If
            Next C
        End If
    Next r

    ' Prove we have the data loaded.
    For r = 0 To num_rows
        For C = 0 To num_cols
            Debug.Print PaymentArray(r, C) & "|";
        Next C
        Debug.Print
    Next r
    Debug.Print "======="

End Sub

Sub CreateBatch()

' Declare custom objects and variables
Dim intDocYear, intDocMonth, intDocDay As Integer
Dim i, k, r, C, intPaymentCount As Integer
Dim strGLACCT, strDescription, strDocumentNumber As String
Dim curPaymentTotal As Currency


' Sage-generated DB connections, views and view composition
Dim mDBLinkCmpRW As AccpacCOMAPI.AccpacDBLink
Set mDBLinkCmpRW = OpenDBLink(DBLINK_COMPANY, DBLINK_FLG_READWRITE)

Dim mDBLinkSysRW As AccpacCOMAPI.AccpacDBLink
Set mDBLinkSysRW = OpenDBLink(DBLINK_SYSTEM, DBLINK_FLG_READWRITE)

Dim temp As Boolean
Dim APPAYMENT1batch As AccpacCOMAPI.AccpacView
Dim APPAYMENT1batchFields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AP0030", APPAYMENT1batch
Set APPAYMENT1batchFields = APPAYMENT1batch.Fields

Dim APPAYMENT1header As AccpacCOMAPI.AccpacView
Dim APPAYMENT1headerFields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AP0031", APPAYMENT1header
Set APPAYMENT1headerFields = APPAYMENT1header.Fields

Dim APPAYMENT1detail1 As AccpacCOMAPI.AccpacView
Dim APPAYMENT1detail1Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AP0033", APPAYMENT1detail1
Set APPAYMENT1detail1Fields = APPAYMENT1detail1.Fields

Dim APPAYMENT1detail2 As AccpacCOMAPI.AccpacView
Dim APPAYMENT1detail2Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AP0034", APPAYMENT1detail2
Set APPAYMENT1detail2Fields = APPAYMENT1detail2.Fields

Dim APPAYMENT1detail3 As AccpacCOMAPI.AccpacView
Dim APPAYMENT1detail3Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AP0032", APPAYMENT1detail3
Set APPAYMENT1detail3Fields = APPAYMENT1detail3.Fields

Dim APPAYMENT1detail4 As AccpacCOMAPI.AccpacView
Dim APPAYMENT1detail4Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AP0048", APPAYMENT1detail4
Set APPAYMENT1detail4Fields = APPAYMENT1detail4.Fields

Dim APPAYMENT1detail5 As AccpacCOMAPI.AccpacView
Dim APPAYMENT1detail5Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AP0170", APPAYMENT1detail5
Set APPAYMENT1detail5Fields = APPAYMENT1detail5.Fields

Dim APPAYMENT1detail6 As AccpacCOMAPI.AccpacView
Dim APPAYMENT1detail6Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AP0406", APPAYMENT1detail6
Set APPAYMENT1detail6Fields = APPAYMENT1detail6.Fields

APPAYMENT1batch.Compose Array(APPAYMENT1header)
APPAYMENT1header.Compose Array(APPAYMENT1batch, APPAYMENT1detail3, APPAYMENT1detail1, APPAYMENT1detail6, APPAYMENT1detail5)
APPAYMENT1detail1.Compose Array(APPAYMENT1header, APPAYMENT1detail2, APPAYMENT1detail4)
APPAYMENT1detail2.Compose Array(APPAYMENT1detail1)
APPAYMENT1detail3.Compose Array(APPAYMENT1header)
APPAYMENT1detail4.Compose Array(APPAYMENT1batch, APPAYMENT1header, APPAYMENT1detail3, APPAYMENT1detail1, APPAYMENT1detail2)
APPAYMENT1detail5.Compose Array(APPAYMENT1header)
APPAYMENT1detail6.Compose Array(APPAYMENT1header)

Dim APPAYMPOST2 As AccpacCOMAPI.AccpacView
Dim APPAYMPOST2Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AP0040", APPAYMPOST2
Set APPAYMPOST2Fields = APPAYMPOST2.Fields

' Initialize batch (One time only)
APPAYMENT1batch.RecordClear
APPAYMENT1batchFields("PAYMTYPE").PutWithoutVerification ("PY")       ' Batch Selector
APPAYMENT1headerFields("BTCHTYPE").PutWithoutVerification ("PY")      ' Batch Type
APPAYMENT1detail3Fields("BATCHTYPE").PutWithoutVerification ("PY")    ' Batch Type
APPAYMENT1detail1Fields("BATCHTYPE").PutWithoutVerification ("PY")    ' Batch Type
APPAYMENT1detail2Fields("BATCHTYPE").PutWithoutVerification ("PY")    ' Batch Type
APPAYMENT1batchFields("PAYMTYPE").PutWithoutVerification ("PY")       ' Batch Selector
APPAYMENT1batchFields("CNTBTCH").PutWithoutVerification ("0")         ' Batch Number
APPAYMENT1batch.RecordCreate 1
APPAYMENT1batchFields("PROCESSCMD").PutWithoutVerification ("1")      ' Process Command Code
APPAYMENT1batch.Process
APPAYMENT1batch.Browse "((PAYMTYPE = ""PY"") AND ((BATCHSTAT = 1) OR (BATCHSTAT = 7) OR (BATCHSTAT = 8)))", 1
APPAYMENT1batchFields("BATCHDESC").PutWithoutVerification ("BDC Payments Import " & PaymentArray(1, 0) & " (Process Date)") ' Description
APPAYMENT1batch.Update
intDocYear = VBA.DateTime.Year(PaymentArray(1, 0))                     ' Set DocDate to ProcessDate
intDocMonth = VBA.DateTime.Month(PaymentArray(1, 0))
intDocDay = VBA.DateTime.Day(PaymentArray(1, 0))
APPAYMENT1batchFields("DATEBTCH").Value = DateSerial(intDocYear, intDocMonth, intDocDay)
APPAYMENT1batchFields("IDBANK").Value = "CBTCHK"                       ' Bank Code
APPAYMENT1batch.Update
APPAYMENT1header.RecordCreate 2 ' Create first header record

'Record Detail Processing Loop
intRowsProcessed = 0
intPaymentCount = 1
booNewHeader = True
For i = 1 To (intRecordCount) ' Process the next invoice record
    'Header Test to see if this Payment Number is the same as the previous line
    If booNewHeader Then
        ' Begin Header Loop: assign values to payment header (vendor and payment data)
        booNewHeader = False
        k = 0
        strDocumentNumber = PaymentArray(i, 4)
        APPAYMENT1batch.Read
        APPAYMENT1headerFields("TEXTRMIT").Value = PaymentArray(i, 5) & " BDC#" & PaymentArray(i, 4)    ' Create new payment header after last detail line (even if no more header records are needed)
        APPAYMENT1headerFields("RMITTYPE").Value = "4"                        ' Payment Trans. Type
        APPAYMENT1headerFields("PROCESSCMD").PutWithoutVerification ("0")     ' Process Command Code
        APPAYMENT1header.Process
        APPAYMENT1headerFields("IDVEND").Value = PaymentArray(i, 6)           ' Vendor Number
        APPAYMENT1headerFields("CNTENTR").PutWithoutVerification ("0")        ' Entry Number
        intDocYear = VBA.DateTime.Year(PaymentArray(i, 21))
        intDocMonth = VBA.DateTime.Month(PaymentArray(i, 21))
        intDocDay = VBA.DateTime.Day(PaymentArray(i, 21))
        APPAYMENT1headerFields("DATERMIT").Value = DateSerial(intDocYear, intDocMonth, intDocDay)        ' Payment Date/Adjustment Date
        APPAYMENT1headerFields("PROCESSCMD").PutWithoutVerification ("0")      ' Process Command Code
        APPAYMENT1header.Process
        APPAYMENT1headerFields("IDACCTSET").Value = "STD"                      ' Account Set
        APPAYMENT1headerFields("PAYMCODE").Value = "BDC"                       ' Payment Code
        APPAYMENT1headerFields("SWPRNTRMIT").Value = "0"                       ' Check Print Required
        APPAYMENT1headerFields("IDRMIT").Value = Right(PaymentArray(i, 4), 7)  ' Check Number
        APPAYMENT1headerFields("TXTRMITREF").Value = "BDC " & PaymentArray(i, 22)         ' Entry Reference
        APPAYMENT1detail1.RecordClear
     End If
    'Begin Detail Loop: Initialize and assign values to payment detail lines (specific invoices being paid)
    k = k - 1
    APPAYMENT1detail1.RecordCreate 0
    APPAYMENT1detail1Fields("IDINVC").Value = PaymentArray(i, 17)          ' Document Number
    APPAYMENT1detail1Fields("PROCESSCMD").Value = "12"                     ' Process Command
    APPAYMENT1detail1.Process
    APPAYMENT1detail1Fields("AMTPAYM").Value = PaymentArray(i, 18)         ' Payment Amount
    APPAYMENT1detail1Fields("CNTLINE").PutWithoutVerification (k)          ' Line Number (k)
    APPAYMENT1detail1.Insert
    'Test for end of batch before looking ahead in array to see if we need a new payment record
    If i < (intRecordCount) Then
        'See if the next record is a line on the same remittance
        If Trim(strDocumentNumber) <> Trim(PaymentArray(i + 1, 4)) Then
            ' Create new payment header after last detail line (even if no more header records are needed)
            APPAYMENT1header.Insert
            APPAYMENT1batch.Read
            APPAYMENT1headerFields("CNTENTR").PutWithoutVerification ("0")  ' Entry Number
            APPAYMENT1header.RecordCreate 2
            booNewHeader = True
        Else
            APPAYMENT1detail1.Read
            APPAYMENT1detail1.Update
        End If
    Else
        ' Create new payment header after last detail line (even if no more header records are needed)
        APPAYMENT1header.Insert  'THIS IS WHERE IT RETURNS THE ERROR: INVOICE NUMBER CANNOT BE BLANK
        APPAYMENT1batch.Read
        APPAYMENT1headerFields("CNTENTR").PutWithoutVerification ("0")       ' Entry Number
        APPAYMENT1header.RecordCreate 2
        booNewHeader = True
    End If
    intRowsProcessed = intRowsProcessed + 1
Next

End Sub

Function ParseLine(ByVal oneLine As String) As String()
        ' Returns an array containing the values of the comma-separated fields.
        ' This pattern actually recognizes the correct commas.
        ' The Regex.Split() command later gets text between the commas.
        Dim strPattern As String: strPattern = ",(?=(?:[^""]*""[^""]*"")*(?![^""]*""))"
        Dim strReplace As String: strReplace = "|"
        Dim regEx As New RegExp
        Dim ColCount() As Variant
        With regEx
            .Global = True
            .MultiLine = False
            .IgnoreCase = False
            .pattern = strPattern
        End With
        parsed_line = regEx.Replace(oneLine, strReplace)
    End Function