Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

CSV Import, Multiselect

Betrifft: CSV Import, Multiselect von: andthen
Geschrieben am: 04.11.2014 13:33:49

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

  

Betrifft: AW: CSV Import, Multiselect von: Rudi Maintaire
Geschrieben am: 04.11.2014 14:18:09

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


  

Betrifft: AW: CSV Import, Multiselect von: andthen
Geschrieben am: 04.11.2014 15:27:45

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