Hallo zusammen,
ich importiere aus einem Verzeichnis mehre TXT-Dateien in ein Excel Sheet mittels dem angehängten VBA script. Soweit, so gut....
Dabei habe ich nun 3 Probleme, zu denen ich nicht richtig Abhilfe schaffen kann:
1) beim Import werden aus der Text-Datei die Umlaute nicht richtige umgesetzt, wie z.B.
"TBS: allen g'fällts hier" anstatt " "TBS: allen gefällts hier" |
2) es sollte nach jeder einzelnenen Text-Datei eine Leerzeile eingefügt werden, jetzt wird der Inhalt jeder Txt-Datei am Stück runter aneinandergereiht
3) derzeit funktioniert der Import nur, wenn ALLE txt-Dateien in einem Verzeichnisordner sich befinden. Es soll jedoch der Pfad dahingehend erweitert werden, dass das script auch Unterordner des Hauptordners einbezieht. D.h., das Script soll automatisch im betrefffenden Hauptordner alle Unterordner nach txt-Dateien durchsuchen und importieren.
Meine VBA Kenntisse erstrecken sich leider nur gänzlich einfaches ändern oder kopieren von funktionsfähigen scripts und bin daher auf Hilfe der Spezialisten angewiesen. Wenn mir jemand zu einem oder allen Fragen einen Hinweis liefern könnte, wäre dies super!!
Danke im voraus und GRuss,
Karl
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Tmp\test_txt\" & "*.txt")
Do While DateiName <> ""
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Tmp\test_txt\" & DateiName, Destination:=Range("C" & ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1))
.Name = DateiName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.Refresh BackgroundQuery:=False
End With
DateiName = Dir
Loop
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
|