MS Access VBA Export all Tables Function To Delimited Format for versions 2000, 2002, 2003, 2007

Public Function ExportToCSV(TableName As String , _
      strFile As String , _
      Optional tfQualifier As Boolean , _
      Optional strDelimiter As String = "," , _
      Optional FieldNames As Boolean ) As Byte

   'References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
   'Set references by Clicking Tools and Then References in the Code View window
   '
   ' Exports a table to a text file.
   ' Accepts
   ' Tablename: Name of the Target Table
   ' strFile: Path and Filename to Export the table to
   ' tfQualifier: True or False
   'strDelimiter: String Value defaults to comma: ,
   ' FieldNames: True or False
   '
   'USAGE: ExportToCSV TableName, strFile, True, ",", True
   On Error GoTo errhandler 

   Dim intOpenFile As Integer , x As Integer
   Dim strSQL As String , strCSV As String , strPrint As String , strQualifier As String

   'Close any open files, not that we expect any
   Reset

   'Grab Next Free File Number
   intOpenFile = FreeFile

   'OPen our file for work
   Open strFile For Output Access Write As # intOpenFile

   'Write the contents of the table to the file
   'Open the source
   strSQL = "SELECT * FROM " & TableName & " As " & TableName

   'set the qualifer
   strQualifier = Chr( 34 )

   With CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

      'Check if we need Field Names
      If FieldNames = True Then

         For x = 0 To .Fields.Count - 1
            If tfQualifier = True Then
               'Write the Field Names as needed
               'The Qualifier is strQualifier or Quote
               strCSV = strCSV & strQualifier & strDelimiter & strQualifier & _
                     .Fields(x).Name

               'Add last strQualifier
               If x = .Fields.Count - 1 Then
                  strCSV = strCSV & strQualifier
               End If
            Else
               'Write the Field Names as needed
               'No Qualifier
               strCSV = strCSV & strDelimiter & .Fields(x).Name

            End If
         Next x
         'Write to File
         strPrint = Mid(strCSV, Len(strDelimiter) + 2 )
         Print # intOpenFile, strPrint
      End If

      'Write the CSV
      Do Until .EOF
         strCSV = ""
         For x = 0 To .Fields.Count - 1

            'Check for Qualifier
            If tfQualifier = True Then
               'The Qualifier is strQualifier or Quote
               strCSV = strCSV & strQualifier & strDelimiter & strQualifier & _
                     Nz(.Fields(x), vbNullString) 

               'Add last strQualifier
               If x = .Fields.Count - 1 Then
                  strCSV = strCSV & strQualifier
               End If
            Else
               'No Qualifier
               strCSV = strCSV & strDelimiter & Nz(.Fields(x), vbNullString)

            End If
         Next x

         'Eliminate Back to back strQualifiers or Qualifiers if changed
         strCSV = Replace(strCSV, strQualifier & strQualifier, "" )

         strPrint = Mid(strCSV, Len(strDelimiter) + 2 )
         Print # intOpenFile, strPrint
         .MoveNext
      Loop

   End With

ExitHere:
   'Close the file
   Close # intOpenFile

   Exit Function

errhandler:
   With Err
      MsgBox "Error " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, "ExportToCSV"
   End With

   Resume ExitHere
End Function