importieren von .txt files

Question

Hallo,

habe folgendes Problem:
Ich habe in einem Ordner unterschiedliche .txt files. Diese sind Ergebnisdateien, welche aus einem
C-Programm generiert werden. Die Struktur der Inhalte der .txt files ist bereits an Excel angepasst.
Mein Ziel ist nun das automatisierte importieren der .txt files in Excel zur weiteren Bearbeitung.
Habe mir bereits ein Makro aufgezeichnet, der das auch recht gut erledigt. Ich hätte aber nun gerne, bevor der Makro loslegt, eine Abfrage aus welchem Ordner die .txt files abgeholt werden sollen. Insgesamt sollen 5 unterschiedliche .txt files in jeweils eine Registerkarte importiert werden. Folglich
müssen 5 Abfragen erstellt werden (immer noch sehr aufwendig). Die .txt files haben jedoch immer die gleich Endung: 3d.txt , kom.txt, usw.! Idealerweis reicht eine Angabe des Ordners in dem sich die .txt files befinden und die .txt files werden entsprechend ihrer Endung in die vorab definierte Registerkarte geladen.
Ist das prinizipiell möglich?

Freue mich über jede konstruktive Idee!

Danke und Grüße

Schimonku

Answer 1

hi :-)

ein beispiel

gruss nighty

Sub DeinMakro()
'Deklaration DeineVariable
DeineVariable = OrdnerAuswahl
End Sub

Function OrdnerAuswahl() As String
On Error GoTo FehlerRoutine
Dim AppShell As Object
Dim BrowseDir As Variant
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
End Function

Answer 2

hi :-)

die zeile

On Error GoTo FehlerRoutine

kann gelöscht werden oder mit entsprechender sprungadresse genutzt werden

gruss nighty

Answer 3

Hi nighty,

Danke für deine Unterstützung!

Habe deine Vorschlag eingefügt und die Ordnerabfrage funktioniert soweit.
Es wäre besser, wenn ich die einzulesende .txt separat auswählen kann. In deiner Funktion kann ich nur Ordner auswählen.
Außerdem sind in meinem Makro die ursprünglichen Dateipfade enthalten. Im Grunde kann ich diese nun Löschen und immer deine Funktion aufrufen?
Bin leider VBA Anfänger und blicke noch nicht so ganz durch!

Kannst du mit einen Tip geben, wie ich deine Funktion einbaue?

Grüße

Schimonku

Anbei mal mein Makro inkl. deiner Funktion:


Sub Import_Txt()

DeineVariable = OrdnerAuswahl
End Sub
Function OrdnerAuswahl() As String
Dim AppShell As Object
Dim BrowseDir As Variant
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Programm\Finale_ET.txt" _
, Destination:=Range("$C$3"))
.Name = "Finale_ET"
.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)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets.Add After:=Sheets(Sheets.Count)
Range("C3").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;U:\Programm\Finale_3d.txt" _
, Destination:=Range("$C$3"))
.Name = "Finale_3d"
.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(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileThousandsSeparator = " "
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets.Add After:=Sheets(Sheets.Count)
Range("C3").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;U:\Programm\Finale_Kom.txt" _
, Destination:=Range("$C$3"))
.Name = "Finale_Kom"
.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)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets.Add After:=Sheets(Sheets.Count)
Range("C3").Select
.....