Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1388to1392
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

CSV Import, Multiselect

CSV Import, Multiselect
04.11.2014 13:33:49
andthen
Hallo Zusammen,
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: CSV Import, Multiselect
04.11.2014 14:18:09
Rudi
Hallo,
als Anregung:
Sub aaa()
Dim vntPathAndFileName, vntPathAndFileArray, i As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Add "CSV-Files", "*.csv", 1
.FilterIndex = 1
If .Show = -1 Then
ReDim vntPathAndFileArray(1 To .SelectedItems.Count)
For i = 1 To .SelectedItems.Count
vntPathAndFileArray(i) = .SelectedItems(i)
Next
End If
End With
If IsArray(vntPathAndFileArray) Then
For i = 1 To UBound(vntPathAndFileArray)
vntPathAndFileName = vntPathAndFileArray(i)
'dein Code ab On Error GoTo ErrorHandler:
'bis
'aktSheet.Select
Next i
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Calculate
End Sub

Gruß
Rudi

Anzeige
AW: CSV Import, Multiselect
04.11.2014 15:27:45
andthen
Hallo Rudi,
vielen Dank für deine Antwort !
Ich musste

If IsArray(vntPathAndFileArray) Then
For i = 1 To UBound(vntPathAndFileArray)
Const AbZeileImport& = 7
vntPathAndFileName = vntPathAndFileArray(i)

noch in deinen Vorschlag einfügen, dann hat es einwandfrei funktioniert.
Besten Dank nochmal
Grüße
andthen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige