En poursuivant votre navigation sur ce site, vous acceptez l'utilisation de cookies pour vous proposer des contenus et services adaptés. Mentions légales.

Recherche

Recherche

Les mémos

Je débute...

Visites

 1218278 visiteurs

 10 visiteurs en ligne

Nous contacter

Contact

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


Catégorie : Les mémos - Fichiers
Page lue 8130 fois

Vous êtes ici :   Accueil » Générer fichier TXT