Creating an AIB Credits transfer file in VBA
This is the code I use to create an IBB transfer file, this can be linked to Sage, Syspro, Intact or any Accounting system which allow an ODBC connection. This contains a fe functions such as Getpref which pulls preference data from another table. These can be replaced with static data or your own functions.
The first part makes the the payee file….
Function CreatePayeeFile()
On Error GoTo Errorhandler
DoCmd.Hourglass True
Dim db As Database
Dim rst As Recordset
Dim SqlStr As String
Dim myfile As Integer, tmpStr As String
Dim tmpfile As String, tmpPath As String
Set db = CurrentDb()
Set rst = db.OpenRecordset("qryPayeeExport")
'assign variables
'file
myfile = FreeFile
'check file name and path
If Len(GetPref("Payee File Name") & "") = 0 Then
MsgBox ("File name required, please review setup details")
GoTo Exit_Func
Else
tmpPath = GetPref("Export File Path")
tmpfile = GetPref("Payee File Name")
End If
If rst.RecordCount > 0 Then
'move to the first record
rst.MoveFirst
'open the file for output
Open (tmpPath & "" & tmpfile) For Output As myfile
Do While Not rst.EOF
tmpStr = Chr(34) & rst!V_Payee & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_VendorID & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Name & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Address & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Phone & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Fax & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Telex & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Bank_Name & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Bank_Code_Type & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Bank_Code & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Account_Number & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_International & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_EDIFact_ID & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_EDIFACT_Qualifier & Chr(34) & ","
tmpStr = tmpStr & Chr(34) & rst!V_Vendor_Ref & Chr(34) & ","
Print #myfile, tmpStr
rst.MoveNext
Loop
'MsgBox ("File Export Complete")
'Else
'MsgBox ("No Payee Records to Export")
End If
Exit_Func:
Set db = Nothing
Set rst = Nothing
DoCmd.Hourglass False
Close #myfile
Exit Function
Errorhandler:
MsgBox "An Error has Occurred " & vbCrLf & _
"Error Number :" & Err.Number & vbCrLf & _
"Details :" & Err.Description
GoTo Exit_Func
End Function
The second part creates the payee file
Function CreatePaymentFile()
On Error GoTo Errorhandler
DoCmd.Hourglass True
Dim db As Database
Dim rst As Recordset
Dim SqlStr As String
Dim myfile As Integer, tmpStr As String, tmpVer As String
Dim tmpfile As String, tmpPath As String, tmpLine As String, tmpComma
tmpComma = ","
Set db = CurrentDb()
Set rst = db.OpenRecordset("qryPaymentFile")
tmpVer = GetPref("AIB Program Version")
'increment the payment run to get a new run number
SetPref "Payment File Name", GetPref("Payment File Name") + 1, "Program", "System"
'assign variables
'file
myfile = FreeFile
'check file name and path
If Len(GetPref("Payment File Name") & "") = 0 Then
MsgBox ("Payment File name required, please review setup details")
GoTo Exit_Func
Else
tmpPath = GetPref("Export File Path")
tmpfile = right("00000000" & GetPref("Payment File Name"), 8) & ".imp"
End If
If rst.RecordCount > 0 Then
'move to the first record
rst.MoveFirst
'open the file for output
Open (tmpPath & "" & tmpfile) For Output As myfile
Do While Not rst.EOF
tmpLine = ""
tmpLine = tmpLine & rst!PY_Payer & tmpComma 'field 1
tmpLine = tmpLine & "EUR" & tmpComma 'field 2
tmpLine = tmpLine & "WT" & tmpComma 'field 3
tmpLine = tmpLine & "SHA" & tmpComma 'field 4
tmpLine = tmpLine & rst!PY_Currency & tmpComma 'field 5
tmpLine = tmpLine & rst!PY_Amount & tmpComma 'field 6
tmpLine = tmpLine & Format(rst!PY_ValueDate, "DD-MM-YYYY") & tmpComma 'field 7
tmpLine = tmpLine & Left(RegReplace(rst!V_Name) & "", 35) & tmpComma 'field 8
tmpLine = tmpLine & Left(RegReplace(rst!V_Address) & "", 35) & tmpComma 'field 9
tmpLine = tmpLine & "" & tmpComma 'second address line blank 'field 10
tmpLine = tmpLine & rst!PY_Reference & tmpComma 'field 11
tmpLine = tmpLine & "" & tmpComma 'optional unique ref 'field 12
tmpLine = tmpLine & rst!V_Account_Number & tmpComma 'Bank account 'field 13
If IsNumeric(Left(rst!V_Bank_Code, 1)) = False Then
tmpLine = tmpLine & rst!V_Bank_Code & tmpComma 'Bank code 'field 14
tmpLine = tmpLine & "" & tmpComma 'bank clearing code if no iban 'field 15
tmpLine = tmpLine & "" & tmpComma 'party bank clearing code if 15 is p 'field 16
Else
tmpLine = tmpLine & "" & tmpComma 'Bank code 'field 14
tmpLine = tmpLine & rst!V_Bank_Code & tmpComma ' 'field 15
tmpLine = tmpLine & rst!V_Bank_Code_Type & tmpComma 'party bank clearing code if 15 is pop'field 16
End If
tmpLine = tmpLine & rst!V_CountryCode & tmpComma 'bank country code 'field 17
tmpLine = tmpLine & "" & tmpComma 'optional 'field 18
tmpLine = tmpLine & "" & tmpComma 'optional 'field 19
tmpLine = tmpLine & "" & tmpComma 'optional 'field 20
tmpLine = tmpLine & "" & tmpComma 'optional 'field 21
tmpLine = tmpLine & "" & tmpComma 'optional 'field 22
tmpLine = tmpLine & "" 'optional 'field 23
Print #myfile, tmpLine
rst.MoveNext
Loop
If MsgBox("Print Reports ", vbYesNo) = vbYes Then
DoCmd.OpenReport "your reports...."
End If
MsgBox ("File Export Complete")
Else
MsgBox ("No Payment Records to Export")
End If
Exit_Func:
Set db = Nothing
Set rst = Nothing
DoCmd.Hourglass False
Close #myfile
Exit Function
Errorhandler:
MsgBox "An Error has Occurred " & vbCrLf & _
"Error Number :" & Err.Number & vbCrLf & _
"Details :" & Err.Description
GoTo Exit_Func
End Function
