CSV Import, Multiselect
04.11.2014 13:33:49
andthen
ich habe zur Zeit noch folgendes Problem:
Sub CsvMitSemikolonDelimiterInSheetEinfuegen3()
Dim wksN As Excel.Worksheet, TmpSheet As Worksheet, aktSheet As Object
Dim qtbN As Excel.QueryTable
Dim vntPathAndFileName As Variant
Dim lngLetzteZeileSpalteA As Long
Const AbZeileImport& = 7
vntPathAndFileName = Application.GetOpenFilename( _
FileFilter:="csv Files (*.csv), *.csv", _
Title:="Meine Dateien ", _
MultiSelect:=False)
If VarType(vntPathAndFileName) = vbBoolean Then
MsgBox "Abgebrochen!"
Exit Sub
End If
On Error GoTo ErrorHandler:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wksN = ThisWorkbook.Worksheets("Basisdaten")
lngLetzteZeileSpalteA = wksN.Cells(wksN.Rows.Count, 1).End(xlUp).Row
Set aktSheet = ActiveSheet
Set TmpSheet = Sheets.Add
Set qtbN = TmpSheet.QueryTables.Add("TEXT;" & vntPathAndFileName, TmpSheet.Cells(1, 1))
qtbN.FieldNames = True
qtbN.RowNumbers = False
qtbN.FillAdjacentFormulas = False
qtbN.PreserveFormatting = True
qtbN.RefreshOnFileOpen = False
qtbN.RefreshStyle = xlOverwriteCells
qtbN.SaveData = True
qtbN.AdjustColumnWidth = False
qtbN.RefreshPeriod = 0
qtbN.TextFilePromptOnRefresh = False
qtbN.TextFilePlatform = xlWindows
qtbN.TextFileStartRow = 1
qtbN.TextFileParseType = xlDelimited
qtbN.TextFileTextQualifier = xlTextQualifierNone
qtbN.TextFileTabDelimiter = False
qtbN.TextFileSemicolonDelimiter = True
qtbN.TextFileCommaDelimiter = False
qtbN.TextFileSpaceDelimiter = False
qtbN.TextFileSemicolonDelimiter = True
qtbN.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
qtbN.Refresh BackgroundQuery:=False
qtbN.Delete
With TmpSheet
.Rows(1).Resize(AbZeileImport - 1).Delete
.Range(TmpSheet.Cells(1, 1), .Cells(1, 1).End(xlDown)).EntireRow.Copy wksN.Cells( _
lngLetzteZeileSpalteA + 1, 1)
End With
ErrorHandler:
If Err.Number 0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
On Error Resume Next
If Not TmpSheet Is Nothing Then TmpSheet.Delete
aktSheet.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Calculate
End Sub
Über dieses Makro spiele ich meine CSV-Dateien forlaufend untereinander ab Zeile 7 in meine Exceltabelle ein. Wie muss ich dieses Makro abändern damit eine Mehrfachauswahl von Dateien möglich ist und ich nicht jede Datei einzeln einspielen muss?
Aufgrund meiner nahezu nicht vorhandenen VBA-Kenntnisse habe ich zuerst auf die einfachste _ Moeglichkeit gehofft und
MultiSelect:=True)
eingegeben, was leider nur zu der Fehlermeldung "Typen unverträglich" beim Einspielen der CSV Dateien führt.Ich hoffe ihr könnt mir weiterhelfen und bedanke mich im Voraus!
MfG
andthen