Dateinamen als Tabellenblattnamen einlesen
17.01.2017 17:00:16
Lisa
ich habe schon wieder ein Frage (so langsam komme ich mir fast schon blöd vor...). Aber hier habe ich bisher immer so tolle Hilfe bekommen, von daher versuche ich es einfach weiterhin.
Ich nutze den unten stehenden Code, um alle .txt Dateien aus einem Ordner hintereinander in meine Arbeitsmappe einzulesen. Dabei bleibt das Blatt namens "Berechnung" am Beginn stehen. Das Problem besteht darin, dass die Tabellenblätter aus irgendeinem Grund nicht den Namen der Dateien bekommen, sondern "Tabelle x" heißen. Der Name wäre aber für die weitere Verwendung der Daten wichtig.
Wo stehe ich auf dem Schlauch?
Sub C_Dateien_laden()
Dim strPfad As String, strFileName As String
Dim FSO As Object
Dim file As Object
Dim lngLR As Long
'Lösche alle Worksheets bevor die neuen geladen werden
Application.DisplayAlerts = False
For Each wks In ActiveWorkbook.Sheets
If Worksheets.Count > 1 And wks.Name "Berechnung" Then
wks.Delete
ElseIf Worksheets.Count = 1 Then
Exit Sub
End If
Next wks
Application.DisplayAlerts = True
'Anpassen
strPfad = "K:\Neue Instruktionen_Win\"
Set FSO = CreateObject("scripting.filesystemobject")
For Each file In FSO.getfolder(strPfad).Files
strFileName = file.Name
Sheets.Add.Move after:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strPfad & strFileName, _
Destination:=Range("A1"))
.Name = "strFileName"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMSDOS
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next
End Sub