Discussion :

[Invité]

Bonjour,
Oui sans problème, mais il ne faut plus considérer un fichier mais un répertoire? Car ce répertoire sera considéré comme serveur de base de données ou tous les Csv seront des tables!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
45
46
47
48
49
50
51
52
53
54
55
56
57
 
Dim Cn As Object, txt As String
Sub test()
Dim rep As String
txt = "[F.CSV]" & vbCrLf & _
"Format=Delimited(;)"
rep = ChoixRepertoire()
If rep = "" Then Exit Sub
Importer rep, Sheets("Feuil3").Range("A2")
End Sub
Sub Importer(Repertoire As String, Destination As Range)
Dim Table As String
Set Cn = CreateObject("ADODB.Connection")
    With Cn
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Repertoire & ";Extended Properties=""Text;HDR=YES;FMT=Delimited;"";"
        Table = PremiereTableAdo
        If Table <> "" Then
            NewFichierTxt Repertoire & "\schema.ini", Replace(txt, "F.CSV", Replace(Table, "#", "."))
           Destination.CopyFromRecordset .Execute("SELECT * FROM [" & Table & "] As FrmExt inner join (select * from [Feuil1$] in '" & ThisWorkbook.FullName & "' 'Excel 12.0;HDR=YES;') As  FrmInt on  FrmInt.a= FrmExt.a")        '---- Lecture des fichiers ---
            Kill Repertoire & "\schema.ini"
            End If
         .Close
    End With
End Sub
 
Public Property Get PremiereTableAdo() As String
With Cn.OpenSchema(20)
    If Not .EOF Then
        PremiereTableAdo = .fields("TABLE_NAME")
    End If
    .Close
End With
End Property
Private Sub NewFichierTxt(Fichier, txt)
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write txt
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Sub
 
 
Function ChoixRepertoire(Optional RepDefault="52") As String
   Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&, RepDefault)
 
    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    ChoixRepertoire = oFolderItem.Path
 
 
End Function