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 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
| Dim Cn As Object, txt As String
Sub test()
Dim rep As String
txt = "[F.CSV]" & vbCrLf & _
"Format=Delimited(;)"
'rep = ChoixRepertoire()
rep = "C:\MyRepertoire\Nouveau dossier"
If rep = "" Then Exit Sub
Set Cn = CreateObject("ADODB.Connection"): Cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & rep & ";Extended Properties=""Text;HDR=YES;FMT=Delimited;"";")
With Sheets("Feuil3")
tbls = TableToutes
If TypeName(tbls) = "Variant()" Then
For i = 0 To UBound(tbls, 2)
Importer rep, .Cells(.Cells.Rows.Count, "A").End(xlUp).Offset(1), CStr(tbls(2, i)), True
Next
End If
End With
End Sub
Sub Importer(Repertoire As String, Destination As Range, Table As String, Entete As Boolean)
With Cn
If Table <> "" Then
NewFichierTxt Repertoire & "\schema.ini", Replace(txt, "F.CSV", Replace(Table, "#", "."))
If TableExiste(Table) Then Destination.CopyFromRecordset .Execute("SELECT * FROM [" & Table & "]")
Kill Repertoire & "\schema.ini"
End If
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
Public Property Get TableExiste(TableName As String) As Boolean
With Cn.OpenSchema(20)
If Not .EOF Then
Debug.Print .fields("TABLE_NAME")
.Filter = "TABLE_NAME ='" & TableName & "'"
TableExiste = Not .EOF
End If
.Close
End With
End Property
Public Property Get TableToutes()
TableToutes = False
With Cn.OpenSchema(20)
If Not .EOF Then
TableToutes = .getrows
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 |
Partager