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
|
Dim Cn As Object, txt As String
Sub test()
Dim Fichier
txt = "[F.CSV]" & vbCrLf & _
"Format=Delimited(;)"
'
'Fichier = Application.GetOpenFilename("Fichier Excel,*.xlsx")
'If Fichier = False Then Exit Sub
Importer "C:\MyRepertoire\Nouveau dossier", 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 |
Partager