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 82 83 84 85 86 87
|
Sub ImportCSV()
'
' ImportCSV Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+J
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets.Add.Name = "New"
For Each xWs In Application.ActiveWorkbook.Worksheets
If xWs.Name <> "New" Then
xWs.Delete
End If
Next
Dim filepath As String, file As String, fileName As Variant, folder As String
Dim first As Boolean
folder = ActiveWorkbook.Path + "\"
fileName = Dir(folder + "*Configuration*" + "*.csv*")
While fileName <> ""
filepath = folder + fileName
file = Mid(fileName, 17)
file = Left(file, Len(file) - 4)
If Len(file) >= 31 Then
file = Left(file, 31)
End If
If first = False Then
Sheets(ActiveSheet.Name).Name = file
first = True
Else
Sheets.Add.Name = file
' MsgBox file
Sheets(file).Activate
End If
With Sheets(file).QueryTables _
.Add(Connection:="TEXT;" & filepath, Destination:=ActiveCell)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMSDOS
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Debug.Print filepath
If Len(Dir$(filepath)) > 0 Then
'First remove readonly attribute, if set
SetAttr filepath, vbNormal
Kill (filepath)
End If
Set fileName = Nothing
fileName = Dir
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub |
Partager