VBA Dateiauswahl - Bei Abbruch Laufzeitfehler 5, jemand Ideen?

Hallo zusammen,

was müsste ich hinzufügen, um den Laufzeitfehler 5 zu umgehen? Wenn ich den VBA-Code ausführe, öffnet sich das Fenster für den Import von DAT-Dateien. Drücke ich auf Abbrechen, erscheint der Laufzeitfehler 5. Vermerkt wird der Code "Set F = fs.GetFolder(strPfad)". Wo und welchen Code müsste ich hinzufügen, um den Fehler zu beheben? Vielen Dank im Voraus. :)

Sub Schaltfläche1_Klicken()
'
'
'*** Öffnen von DAT-Dateien
Dim strText As String, strFilter As String

strText = "Bitte eine Auswertung Auswählen"
strFilter = "DAT-Dateien (*.DAT), *.DAT"""
strAuswahl = Application.GetOpenFilename(strFilter, 1, strText)
strPfad = Pfad_ermitteln(strAuswahl)
'
Set fs = CreateObject("Scripting.FileSystemObject")
Set F = fs.GetFolder(strPfad)
Set fc = F.Files

If ActiveSheet Is Nothing Then Workbooks.Add
For Each File In fc
    Zeile = Cells(65000, 1).End(xlUp).Row + 2
    strEinfügen = Cells(Zeile, 1).Address
    strAuswahl = File.Path

    'Einfügen
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strAuswahl _
        , Destination:=Range(strEinfügen))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = ","
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
  End With
  Range(strEinfügen).QueryTable.Delete
Next
End Sub
_______________________________

 Function Pfad_ermitteln(ByVal strAuswahl As String) As String
 
 For i = Len(strAuswahl) To 1 Step -1
    If Mid(strAuswahl, i, 1) = "\" Then
        Pfad_ermitteln = Left(strAuswahl, i - 1)
        Exit Function
    End If
Next
End Function

Answer 1

[Krabat693]

Wenn du in deinem Dateiauswahl Fenster auf abbrechen drückst kommt ja dennoch eine Ausgabe von diesem zurück welche dann in deine Variable geschrieben wird.

Allerdings ist das ja kein Dateipfad und dementsprechend kann FS.getfolder() damit nichts anfangen und bricht mit einem Fehler ab.

Du musst also vorher kontrollieren was in deiner Variable steht und wenn dass der Rückgabe von "abbrechen" entspricht beendest du das Programm.

Woher ich das weiß: Berufserfahrung – Administrator mit über 12 Jahren Berufserfahrung

Comments

[fatih575757]

Vielen Dank für die Info :) Wie wäre denn der Code, welches ich hinzufügen müsste und wohin? :)

[Krabat693]

@fatih575757

Und wenn ich dir das jetzt vorkaue lernst du was dabei?

Also:

1. Schau dir Mal an was in der Variable steht wenn du in der Datei Auswahl auf abbrechen klickst. Das kannst du zb mit einem debug.print strpfad machen. Gleich machen du strpfad zugewiesen hast
2. Jetzt wo du weißt was in der Variable steht wenn du auf abbrechen klickst kannst du überprüfen ob in der Variable der Böhse abbrechen Wert steht if strpfad = ...
3. wenn die Bedingung zutrifft musst du entsprechend nur das Programm beenden, das geht mit Exit Sub
4. Die Überprüfung muss selbstverständlich stattfinden bevor die Variable dazu verwendet wird mit FS.getfolder den Pfad einzulesen, idealerweise direkt nach der Zuweisung.

[fatih575757]

@Krabat693

....

strpfad = Pfad_ermitteln(strAuswahl)

If strpfad = Wahr Then Exit Sub

Set fs = CreateObject("Scripting.FileSystemObject")

Set F = fs.GetFolder(strpfad)

Set fc = F.Files

....

so, das wäre die Lösung. Nun Schließt sich das Fenster beim Abbrechen problemlos :) Vielen Dank! Die Variable für strpfad ist "Wahr" :)

Answer 2

[IchMalWiederXY]

Es gibt in VBA auch den "FileDialog", der des alles ganz einfach macht,zumindest, wenn man files in "einem" Verzeichnis auswählt.Die "If" Anweisung kümmert sich um abbrechen:Sub GetFilePathBasic()

  ' (1) Shows the msoFileDialogFilePicker dialog box.

' (2) Checks if the user picked a file.
' (3) Stores the path to the selected file in a string type variable.

    Dim strFilePath As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True              
        ' show the file picker dialog box
        If .Show <> 0 Then
            strFilePath = .SelectedItems(1)
        
            ' *********************
            ' put your code in here
            ' *********************
            
            ' Example: print the path of the selected file to the immediate window
            Debug.Print strFilePath ' remove in production
        End If
    End With
End Sub

Hier gibt es noch weitere details:
VBA Select Files with msoFileDialogFilePicker - wellsr.com

Generell kannst du aber viel Hilfe dazu auch nach ner Google Suche finden.

Answer 3

[Suboptimierer]

Du könntest mit dem DIR-Befehl prüfen, ob es das Verzeichnis gibt.

https://www.xelplus.com/excel-vba-check-if-file-folder-exists-dir/

Wenn der Dialog abgebrochen wird, wird False in das Variant zurückgegeben. Das kannst du abfragen.

https://docs.microsoft.com/de-de/office/vba/api/excel.application.getopenfilename

Comments

[fatih575757]

Hab es nun gelöst :) Vielen Dank.

[Suboptimierer]

@fatih575757

Bitteschön!