Suche Schleife in Code

Sub MehrfachAuswahlcsvDateien()
Dim vntPathAndFileNames As Variant
Dim lngI As Long
Dim wbkZiel As Workbook
Dim wksZiel As Worksheet, strname As String, intFehler As Integer
Dim objAktiv
Dim MsgTitel As String
Const bolFormat As Boolean = False 'bei True wird auch prcFormatImport ausgeführt
MsgTitel = "Import CSV-Datei(en)"
On Error GoTo Fehler
Set objAktiv = ActiveSheet 'aktives Blatt merken
intFehler = 1
Set wbkZiel = ActiveWorkbook
'Dateiauswahl
vntPathAndFileNames = Application.GetOpenFilename( _
fileFilter:="Text Files (*.csv), *.csv", _
Title:="Bitte wählen Sie die zu ladende Datei/en aus!", _
MultiSelect:=True)
If VarType(vntPathAndFileNames) = vbBoolean Then
MsgBox "Sie haben abgebrochen.", vbOKOnly, MsgTitel
GoTo Fehler
Else
Application.ScreenUpdating = False
'Dateien abarbeiten
For lngI = 1 To UBound(vntPathAndFileNames)
intFehler = 2
'Blattname aus Dateiname ermitteln
strname = vntPathAndFileNames(lngI)
'Verzeichnis abtrennen
strname = Mid(strname, InStrRev(strname, "\") + 1)
Application.StatusBar = "Importiere Datei " & lngI & " von " & UBound( _
vntPathAndFileNames) & " : " & strname
'".csv" abtrennen
strname = Left(strname, InStrRev(strname, ".") - 1)
'ggf. Name auf 31 Zeichen kürzen
If Len(strname) > 31 Then strname = Left(strname, 31)
'neues Blatt am Ende einfügen
intFehler = 3
With wbkZiel
.Worksheets.Add After:=.Sheets(.Sheets.Count)
Set wksZiel = ActiveSheet
wksZiel.Name = strname
End With
'Datenimport
intFehler = 4
With wksZiel.QueryTables.Add( _
Connection:="TEXT;" & vntPathAndFileNames(lngI), _
Destination:=wksZiel.Range("$A$1"))
.Name = strname
.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 = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
'Datenverbing zur CSV-Datei wieder löschen
.WorkbookConnection.Delete
End With
If bolFormat = True Then Call prcFormatImport(wksZiel)
Next_lngI: 'für Fehlerbehandlung, wenn Blatt schon vorhanden
Next
End If
intFehler = 5
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Datenimport ist abgeschlossen"
Fehler:
With Err
MsgTitel = MsgTitel & " - intFehler = " & intFehler
Select Case .Number
Case 0 'alles OK
Case 1004
Select Case intFehler
Case 3 'Name des Tabellenblattes ist schon vorhanden
Select Case MsgBox("Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf  _
_
_
& "Datei: " & vntPathAndFileNames(lngI) & vbLf _
& "Blattname: : " & strname & vbLf _
& "Ersatz-Blattname: " & strname & "(1)" & vbLf & vbLf _
& "Mit ""Wiederholen"" wird der Ersatz-Blattname verwendet." & vbLf _
& "Mit ""Ignorieren"" wird die Datei nicht importiert!", _
vbAbortRetryIgnore + vbQuestion, MsgTitel)
Case vbAbort
'Angelegtes Blatt wird wieder gelöscht und das Makro beendet
Application.DisplayAlerts = False
wksZiel.Delete
Application.DisplayAlerts = True
Case vbRetry
'Ersatz-Blattname wird verwendet und Import fortgesetzt
strname = strname & "(1)"
Resume
Case vbIgnore
'Angelegtes Blatt wird wieder gelöscht und nächste Datei importiert
Application.DisplayAlerts = False
wksZiel.Delete
Application.DisplayAlerts = True
Resume Next_lngI
End Select
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, MsgTitel
End Select
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, MsgTitel
End Select
End With
'Blatt aktivieren, da beim Start des Makros aktiv war.
objAktiv.Activate
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub