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.
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.