1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
|
Sub TransfertAllCsvInDir()
Dim rep As String
Dim Dossier As String
Dim Nom_Tbl As String
'obtient le premier fichier ou répertoire qui est dans "c:\"
Dossier = "C:\repertoire"
rep = Dir(Dossier & "*.CSV", vbDirectory)
'boucle tant que le répertoire n'a pas été entièrement parcouru
On Error GoTo Erreur
Do While (rep "")
'teste si c'est un fichier ou un répertoire
If (GetAttr(Dossier & rep) And vbDirectory) = vbDirectory Then
'MsgBox "Répertoire " & rep
Else
Nom_Tbl = Left(rep, Len(rep) - 4)
'On attache le fichier trouvé
DoCmd.TransferText acLinkDelim, , Nom_Tbl, Dossier & rep, True
'On Ajoute les données dans la table de destination
DoCmd.RunSQL "INSERT INTO Tabledest ( Champ1, Champ2, Champ3,Champ4 )SELECT Champ1 AS Expr1, Champ2 AS Expr2, Champ3 AS Expr3, Champ4 AS Expr4 FROM [" & Nom_Tbl & "];"
'On libère le fichier
DoCmd.DeleteObject acTable, Nom_Tbl
End If
Suite:
'passe à l'élément suivant
rep = Dir
Loop
GoTo Fin
Erreur:
Fin:
End Sub |
Partager