EXTRACTION DEPUIS UN FICHIER TEXTE ET REMPLISSAGE D'UN BASE DE DONNEES ACCESS EXISTANCES

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