How to add a header and trailer record to my Access Table Export

[Gumbo97]

I'm exporting a table from Microsoft Access, but I need to find a way to add a header and trailer record to that file that includes a record type, ID number, record count and run date. If you can point me in the right direction to figure this out (references, links, etc.) I'd appreciate it. Thanks!

 

[MrBillSC]

I don't think you can get header or trailer records by exporting a table. You can export a report however, then you could create your header (report header) and footer (report footer) records.

MrBill

 

[payback]

I use code to export the data rather than the standard Access export facilities. Then you can manipulate the data as you want it. It requires VB knowledge though - are you familiar with it? If so I can provide an example.

 

[MrBillSC]

Sorry, I'm not very familiar with VB code. However, go ahead and post your code. Maybe some one else will pick up on it.

MrBill

 

[Gumbo97]

Payback, Actually, my VB knowledge is pretty limited, but I have a consultant who knows VB and he's willing to assist in this project.

 

[payback]

This code creates a datafile of fixed length records for a bank import. There are both a header and a footer.

The edit mask @ wil ensure that the particular field is the required length (character or space).

I am sure that after analysis you will be able to modify it to suit your requirements.

Sub Create_Payroll_Hexagon_Schedule(PaymentDate)

Dim dbs As Database
Dim rst As Recordset

Dim strCriteria As String
Dim strLine As String

Dim intX As Integer
Dim intY As Integer

Dim intHash As Long
Dim intTotal As Long

Dim msg, style, filenumber

Set dbs = CurrentDb

intX = 0

DoCmd.OpenForm "frmProcessMessage"
[Forms]![frmProcessMessage]![Description].Caption = "Select payments..."
[Forms]![frmProcessMessage].Repaint

strCriteria = "SELECT * FROM InwardFile " _
& "WHERE UpdateFlag <> True;"

Set rst = dbs.OpenRecordset(strCriteria, dbOpenDynaset)

If rst.RecordCount = 0 Then
msg = "There are no payments to export!"
style = vbOKOnly + vbInformation
MsgBox msg, style
GoTo Exit_Create_Hexagon_Schedule
Else
rst.MoveLast
intY = rst.RecordCount
rst.MoveFirst
End If

filenumber = FreeFile ' Get unused file number.

Open "C:\My Documents\PAYROLL.TXT" For Output As #filenumber

DoCmd.OpenForm "frmProcessMessage"
[Forms]![frmProcessMessage]![Description].Caption = "Creating Header Record..."
[Forms]![frmProcessMessage].Repaint

'Header
strLine = "H"
strLine = strLine & Space(1)
strLine = strLine & Format(PaymentDate, "yyyymmdd")
strLine = strLine & Format(Date, "yyyymmdd")
strLine = strLine & Format(Time(), "hhmmss")
strLine = strLine & Space(96)

Print #filenumber, strLine

'Details
Do Until rst.EOF

intX = intX + 1

DoCmd.OpenForm "frmProcessMessage"
[Forms]![frmProcessMessage]![Description].Caption = "Creating Payment " & intX & " of " & intY
[Forms]![frmProcessMessage].Repaint

strLine = "D"
strLine = strLine & Space(1)
strLine = strLine & Format(rst!ToPayee, "!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@")
strLine = strLine & Mid(rst!ToAccount, 1, 2)
strLine = strLine & Mid(rst!ToAccount, 3, 4)
strLine = strLine & Mid(rst!ToAccount, 8, 7)
strLine = strLine & Mid(rst!ToAccount, 15, 3)
strLine = strLine & Space(3)
strLine = strLine & "52" 'Payroll
strLine = strLine & Format(rst!ToAmount * 100, "@@@@@@@@@@@@@@@")
strLine = strLine & Format(rst!ToParticulars, "!@@@@@@@@@@@@")
strLine = strLine & Format(rst!ToCode, "!@@@@@@@@@@@@")
strLine = strLine & Format(rst!ToReference, "!@@@@@@@@@@@@")
strLine = strLine & Space(11)

Print #filenumber, strLine

intHash = intHash + Val(Mid(rst!ToAccount, 11, 4))
intTotal = intTotal + (rst!ToAmount * 100)

rst.Edit
rst!UpdateFlag = True
rst.Update

rst.MoveNext
Loop

'Trailer
strLine = "T"
strLine = strLine & Format(Right(intHash, 4), "@@@@")
strLine = strLine & Format(intTotal, "@@@@@@@@@@@@@@@")
strLine = strLine & Format(intY, "@@@@")
strLine = strLine & Space(96)

Print #filenumber, strLine

Close #filenumber ' Close file.

Exit_Create_Hexagon_Schedule:

DoCmd.Close acForm, "frmProcessMessage"

rst.Close
Set dbs = Nothing

End Sub

 

[Gumbo97]

Thanks for posting the code! I'll get that to our consultant and see what he can do.