Extraction depuis un fichier texte et remplissage d'un base de donnees access existances

Description

Ce code est là à titre d'exemple pour ceux qui se posent deux questions :
1) Comment j'extrait une chaîne de taille variable ? (Rq : la mettre en début de ligne)
2) C'est comment qu'on fait pour remplir une base de données ACCESS existante ?

Special thanks to Processus qui m'a permis d'éviter de faire gratter mon disque dur pour faire l'extraction.

PS: ce code fonctionne avec la bibliothèque DAO 3.51 de Microsoft
l'exemple est tiré d'une appli pour mon boulot, alors pas de question du genre (qu'est ce qui veux avec ses palettes?)
une dernière chose, la base doit être vide pour qu'il fonctionne sinon vous changer les données du fichier texte.

Source / Exemple :


Dim fs As New FileSystemObject
Dim db As DAO.Database
Dim rc As DAO.Recordset
Dim fil As String, rep As String
Dim str As String
Dim i As Integer
Dim strtable(1 To 13) As String
Dim start, pause

Private Sub transfert_Click()

    Dim strtbl
    
    pause = 2
    Form2.Show
' parametre du chemin et du fichier source
    rep = slash(Dir.Path)
    fil = rep & File
'ouverture de la dase de donnees
    Set db = OpenDatabase(rep & "palette.mdb")
    
    Form2.work.Caption = "Extraction des données..."
    Form2.Refresh
 
'On extrait les donnees 
    Open fil For Input As #1
    i = 1
    Do While Not EOF(1)
        Line Input #1, str
        strtbl = Split(str)
        str = Trim(strtbl(0))
        Debug.Print i & " " & str
        stock str, i 'pour ranger les donnees extraites
        str = ""
        i = i + 1
    Loop
    Close #1

'une pause pour faire beau
    start = Timer
    Do While Timer < start + pause: Loop
    Form2.work.Caption = "Transfert des données..."
    Form2.Refresh

'on remplit la première table de la base    
    Set rc = db.OpenRecordset("palette", dbOpenTable)
    rc.AddNew
    For i = 1 To 7
        rc.Fields(i - 1).Value = strtable(i)
    Next i
    rc.Update
    rc.Close
    
    Set rc = Nothing
   
'on remplit la 2eme table de la base 
    Set rc = db.OpenRecordset("caisses")
    For i = 0 To 4 Step 2
        rc.AddNew
        rc.Fields(0).Value = strtable(1)
        rc.Fields(2).Value = strtable(i + 8)
        rc.Fields(1).Value = strtable(i + 9)
        rc.Update
    Next i
    
    rc.Close

    db.Close
    Set rc = Nothing
    Set db = Nothing
 
' du remplissage pour le fun   
    start = Timer
    Do While Timer < start + pause: Loop
    Form2.work.Caption = "Fin du travail"
    Form2.Refresh
    start = Timer
    Do While Timer < start + pause: Loop
    Unload Form2
    
End Sub

Private Sub Dir_Change()
    File.Path = Dir.Path
    File.Refresh
End Sub

Private Sub Drive_Change()
    Dir.Path = Drive
    Dir.Refresh
End Sub

' un test sur "\" dans le chemin de fichier
Function slash(pathname As String) As String
    If Right(Path, 1) <> "\" Then
        slash = pathname + "\"
    Else
        slash = pathname
    End If
End Function

'Faut bien mettre les donnees quelque part
'Un tableau est une idée
Sub stock(str As String, i As Integer)
        If i > 7 Then GoTo Choix Else GoTo Simple

Choix:  Select Case i
        Case 8: strtable(8) = Left(str, 2)
                strtable(9) = Right(str, 2)
        Case 9: strtable(10) = Left(str, 2)
                strtable(11) = Right(str, 2)
        Case 10: strtable(12) = Left(str, 2)
                strtable(13) = Right(str, 2)
        End Select
        Exit Sub
        
Simple: strtable(i) = str

End Sub

Conclusion :


Ne vous géner pas et donner votre avis, ca peut motiver à mettre d'autres sources, bien meilleures je l'espère.

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.