Mehrere CSV auswählen und importieren
28.09.2020 10:33:59
Marc
ich möchte gerne in einem Makro einen Windows Explorer starten, dort mehrere CSV Dateien auswählen und diese dann in das Tabellenblatt "Start" untereinander wegschreiben und importieren. Dafür habe ich folgendes Makro geschrieben bzw. zusammenkopiert und angepasst... Leider bleibt das Programm immer beim Punkt ".Refresh BackgroundQuery:=False" hängen und bricht ab...
Was mache ich falsch? Hier der Code:
Sub FileSelection_WaWi()
Dim var As Variant
Dim iCounter As Integer
Dim letztezeilevor, letztezeilenach As Long
var = Application.GetOpenFilename( _
FileFilter:="Excel-Dateien (*.CSV), *.CSV", _
MultiSelect:=True)
'On Error GoTo ERRORHANDLER
For iCounter = 1 To UBound(var)
Sheets("Start").Select
letztezeilevor = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("C" & letztezeilevor + 1).Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & var(iCounter) & """" _
, Destination:=Range("$C$" & letztezeilevor + 1))
'.CommandType = 0
.Name = var(iCounter) '"Testdatei"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
_
1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
letztezeilenach = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
Range("A" & letztezeilevor + 1 & ":AZ" & letztezeilevor + 1).Select
Selection.Delete Shift:=xlUp
Range("A" & letztezeilevor & ":B" & letztezeilevor).Select
Selection.AutoFill Destination:=Range("A" & letztezeilevor & ":B" & letztezeilenach)
Next iCounter
Exit Sub
ERRORHANDLER:
Beep
MsgBox "Abbruch!"
End Sub
Danke und Gruß
Marc