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
|
Dim strFilePath As String, strFilename As String, vFullPath As Variant
Dim lngCounter As Long
Dim oConn As Object, oRS As Object, oFSObj As Object
vFullPath = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Choisir le fichier à découper")
If vFullPath = False Then Exit Sub
Application.ScreenUpdating = False
Set oFSObj = CreateObject("Scripting.FileSystemObject")
strFilePath = oFSObj.GetFile(vFullPath).ParentFolder.Path
strFilename = oFSObj.GetFile(vFullPath).Name
Set oConn = CreateObject("ADODB.CONNECTION")
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFilePath & ";" & _
"Extended Properties=""text;HDR=No;FMT=Delimited"""
Set oRS = CreateObject("AdoDb.Recordset")
oRS.Open "SELECT * FROM " & strFilename, oConn, 3, 1, 1
While Not oRS.EOF
Sheets.Add
ActiveSheet.Range("A1").CopyFromRecordset oRS, 65536
Wend
oRS.Close
oConn.Close
Application.ScreenUpdating = True |
Partager