Option Compare Database
Option Explicit
'*********************
'* arnelgp
'*
'* parameters:
'*
'* strTable table/query name or select statement
'* strOutput path and filename to which it will saved (like: z:\test.txt)
'* if not supplied, file will be saved on same folder as the
'* db (text.txt)
'* strDelimiter delimiter to use for export
'* bolExtraSpaceAbove if you need extra space above your header, just passed True
'*
Public Sub DataToText(ByVal strTable As String, Optional ByVal strOutput As String = "", _
Optional ByVal strDelimiter As String = "", _
Optional ByVal bolExtaSpaceAbove As Boolean = False)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim outFile As Integer
Dim i As Integer
Dim LineOfText As String
If strOutput = "" Then strOutput = CurrentProject.Path & "\Text.txt"
If strDelimiter = "" Then strDelimiter = Chr(9)
If Dir(strOutput) <> "" Then Kill (strOutput)
outFile = FreeFile
Open strOutput For Output As #outFile
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset(strTable, dbOpenSnapshot)
With rs
If Not (.BOF And .EOF) Then
.MoveFirst
If bolExtaSpaceAbove Then
Print #outFile, ""
End If
'if you want column headers, uncomment the following 5 lines of code
For i = 0 To .Fields.Count - 1
LineOfText = LineOfText & .Fields(i).Name & strDelimiter
Next i
LineOfText = Left(LineOfText, InStrRev(LineOfText, strDelimiter) - 1)
Print #outFile, LineOfText
'loop through records
Do While Not .EOF
LineOfText = ""
'build up line of text
For i = 0 To .Fields.Count - 1
LineOfText = LineOfText & Nz(.Fields(i)) & strDelimiter
Next i
LineOfText = Left(LineOfText, InStrRev(LineOfText, strDelimiter) - 1)
'write line of text to file
Print #outFile, LineOfText
.MoveNext
Loop
End If
End With
Close #outFile
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
