Générer fichier TXT

Générer ligne par ligne un fichier texte (.txt) avec entêtes

Sub GenerateTXT(strSource As String, _
                Optional strPath As String = "", _
                Optional blnAdd As Boolean = False)
    On Error GoTo errGenerate
    '/
    '/ Générer ligne par ligne un fichier .txt
    '/ avec les noms de champs comme en-têtes
    '/ Si strPath est omis:
    '/   la destination sera le même répertoire que la base
    '/ Si blnAdd est False ou omis:
    '/   un nouveau fichier sera créé, sinon ajouter
    '/
    '/ Syntaxe:  Call GenerateTXT("LaTableouLaRequete", "C:\Mes Documents", True)
    '/      ou   Call GenerateTXT("LaTableouLaRequete", , True)
    '/      ou   Call GenerateTXT("LaTableouLaRequete")
    '/
    Const Separ = vbTab    'séparateur
    Const IdVal = Null    'délimiteur
    Dim Dbs As DAO.Database
    Dim Rst As DAO.Recordset
    Dim Fld As DAO.Field
    Dim strFile As String
    Dim StrHeadFile As String
    Dim TxtLine As String
    Dim Fichier As Integer, i As Integer
    If strPath = "" Then
        strPath = CurrentProject.Path
    End If
    strFile = strPath & "" & strSource & "_" & DCount("*", strSource) & ".txt"
    Set Dbs = CurrentDb
    Set Rst = Dbs.OpenRecordset(strSource)
    Fichier = FreeFile()
    If blnAdd = False Then
        'Créer un nouveau fichier avec en-tête
        Open strFile For Output As #Fichier
        'Lire le nom des champs
        For i = 0 To (Rst.Fields.Count - 1)
            StrHeadFile = StrHeadFile & IdVal & Rst.Fields(i).Name & IdVal & Separ
        Next i
        Print #Fichier, Left(StrHeadFile, Len(StrHeadFile) - Len(Separ))
    Else
        'Ajouter au fichier existant
        Open strFile For Append As #Fichier
    End If
    'Ecriture des lignes
    While Not Rst.EOF
        For Each Fld In Rst.Fields
            TxtLine = TxtLine & IdVal & Fld.Value & IdVal & Separ
        Next Fld
        TxtLine = Left(TxtLine, Len(TxtLine) - Len(Separ))
        Print #Fichier, TxtLine
        Rst.MoveNext
        TxtLine = ""
    Wend
    MsgBox "Fichier " & strFile & " créé.", vbOKOnly, ""
exitGenerate:
    Close #Fichier
    Rst.Close
    Dbs.Close
    Set Rst = Nothing
    Set Dbs = Nothing
    Exit Sub
errGenerate:
    MsgBox Err.Number & " " & Err.Description
    On Error Resume Next
    Resume exitGenerate
End Sub