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