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 35 36 37 38 39 40 41 42 43 44
|
Sub TransfertAllCsvInDir()
Dim Repertoire As String
Dim Dossier As String
Dim Nom_Tbl1, Nom_Tbl2, Nom_Tbl3, Nom_Tbl4 As String
'obtient le premier fichier ou répertoire qui est dans "C:\Documents and Settings\"
Dossier = "C:\Documents and Settings\"
RepFic = Dir(Dossier & "*.CSV", vbDirectory)
'boucle tant que le répertoire n'a pas été entièrement parcouru
On Error GoTo Erreur
Do While (RepFic = "")
'teste si c'est un fichier ou un répertoire
If (GetAttr(Dossier & Repertoire) And vbDirectory) = vbDirectory Then
'MsgBox "Répertoire " & rep
'Else
Nom_Tbl1 = "Table1"
Nom_Tbl2 = "Table2"
Nom_Tbl3 = "Table3"
Nom_Tbl4 = "Table4"
'On attache le fichier trouvé
DoCmd.TransferText acLinkDelim, , Nom_Tbl, Dossier & Repertoire, 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_Tbl1 & "];"
DoCmd.RunSQL "INSERT INTO Tabledest ( Champ1, Champ2, Champ3,Champ4 )SELECT Champ1 AS Expr1, Champ2 AS Expr2, Champ3 AS Expr3, Champ4 AS Expr4 FROM [" & Nom_Tbl2 & "];"
DoCmd.RunSQL "INSERT INTO Tabledest ( Champ1, Champ2, Champ3,Champ4 )SELECT Champ1 AS Expr1, Champ2 AS Expr2, Champ3 AS Expr3, Champ4 AS Expr4 FROM [" & Nom_Tbl3 & "];"
DoCmd.RunSQL "INSERT INTO Tabledest ( Champ1, Champ2, Champ3,Champ4 )SELECT Champ1 AS Expr1, Champ2 AS Expr2, Champ3 AS Expr3, Champ4 AS Expr4 FROM [" & Nom_Tbl4 & "];"
'On libère le fichier
DoCmd.DeleteObject acTable, Nom_Tbl
End If
Suite:
'passe à l'élément suivant
Repertoire = Dir
Loop
GoTo Fin
Erreur:
Fin:
End Sub |
Partager