Mehrere CSV Dateien in Excel importieren
28.01.2013 14:52:11
chandler
ich habe das nachfolgende Makro meinen Bedürfnissen zum Teil angepasst.
Da ich um die 5000 CSV Dateien habe, würde ich gerne die als einzelne XLS Dateien
speichern unter dem gleichen Namen wie die bereits eingelesene CSV.
Noch besser, wenn es möglich wäre, in einer Scheife das ganze Verzeichnis mit den CSVs einlesen und als XLS Dateien abspeichern.
Kann mir jemand helfen?
Sub Makro1()
Dim sPfad As String
Dim oQuery As QueryTable
If Dir("D:\Test", vbDirectory) "" Then
ChDrive "D:"
ChDir "D:\Test"
sPfad = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
If sPfad CStr(False) Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sPfad, Destination:=Range("A1"))
.Name = "sPfad"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = " "
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
For Each oQuery In ActiveSheet.QueryTables
oQuery.Delete
Next oQuery
With Rows("1:1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
Cells.Columns.AutoFit
Range("A1").Select
End If
Else
MsgBox "Der Pfad 'D:\Test' wurde nicht gefunden!", vbCritical
End If
End Sub
Anzeige