Schleife in VBA zum öffnen von txt Dateien

Julius_27759b · 10. November 2019 um 11:26

Hallo,

ich habe eine Frage und ersuche eure Hilfe dazu.

Bei dem Versuch einen Ablauf in zu generieren komme ich nicht mehr weiter.

Mein Ziel ist es 52 Textdateien mit Excel 2003 zu öffnen (Spalten sind mit Tabs getrennt) und anschließend alle Inhalte in eine Tabelle untereinander zu kopieren. Danach sollen die 52 Quelldateien wieder geschlossen werden.

Die Textdateien tragen alle unterschiedliche Namen.

Hier mein Ansatz:

Sub openFiles()

Dim path As String
Dim pattern As String
Dim file As String


path = "Y:\JobList\"
pattern = "JobList20080???.txt"
ChDir path
file = Dir(path & pattern)
Do While file ""
' MsgBox file
 Workbooks.OpenText FileName:=path & file, Origin:= \_
 65001, StartRow:=2, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote \_
 , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= \_
 False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) \_
 , Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), \_
 Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1)), \_
 TrailingMinusNumbers:=True


 file = Dir

 

Range("A1:L300").Select
 Selection.Copy
 Windows("Schleife.xls").Activate
 ActiveSheet.Paste
 ActiveWindow.SmallScroll Down:=2
 Range("A2").Select
Loop

End Sub

Vielen Dank für eure Hilfe.

Grüße

[MOD] - Pre-Tags eingefügt

Manfred_Tessin · 10. November 2019 um 11:27

Hallo, Julius!

Hier mein Ansatz:

Sub openFiles()

Dim path As String
Dim pattern As String
Dim file As String

path = „Y:\JobList“
pattern = „JobList20080???.txt“
ChDir path
file = Dir(path & pattern)
Do While file „“
’ MsgBox file
Workbooks.OpenText FileName:=path & file, Origin:= _
65001, StartRow:=2, DataType:=xlDelimited,
TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True,
Semicolon:=False, Comma:= _
False, Space:=False, Other:=False,
FieldInfo:=Array(Array(1, 1), Array(2, 1) _
, Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1),
Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13,
1), Array(14, 1)), _
TrailingMinusNumbers:=True

file = Dir

Range(„A1:L300“).Select
Selection.Copy
Windows(„Schleife.xls“).Activate
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=2
Range(„A2“).Select
Loop

End Sub

Sieht doch eigentlich ganz passabel aus. Was funktioniert denn nicht?

Ich würde mal folgendes ändern:

Copy-, Paste- u. ä. Methoden auf dem Selection-Objekt sind zu vermeiden. Wenn ein User zwischendrin während der Makroausführung dumm in der Gegend rumklickt, ist nämlich nicht mehr Selected, was Du dachtest.
Verwende für die geöffnete Datei ein zusätzliches Workbook-Objekt. Mit

Dim wbImport as Workbook
Set wbImport = Workbooks.Open…
’ … weitere Aktionen
wbImport.Close False ’ schließen ohne zu speichern
’ …

kannst Du die temporär geöffnete Datei einfach schließen, ohne irgendwie über Workbooks(„WieHießDieDateiGleich.xls“) gehen zu müssen.

Wenn alles untereinander soll, musst Du vorher die Einfüge-Markierung ans Ende setzen. Verwende dazu

DeinImportSheet.Cells(DeinImportSheet.UsedRange.Row + DeinImportSheet.UsedRange.Rows.Count, 1).Select
DeinImportSheet.Paste
Wenn Deine Textdateien nicht immer die gleiche Länge haben, solltest Du auch hier mit UsedRange.Copy nur den verwendeten Bereich kopieren.

Falls das nicht weiterhilft, noch mal genauer fragen.

Gruß, Manfred

Julius_27759b · 10. November 2019 um 11:28

Hallo Manfred,

vielen Dank! Soweit funktioniert es jetzt. Allerdings hat sich ein neuer Fehler herausgestellt…

Die importierten txt Dateien sind nicht identisch, daher kann ich nicht mit der Filterfunktion arbeiten. Daraus entsteht für mich die Frage, ob es die Möglichkeit gibt, nach dem Wort „???“ zu suchen und die ganze Zeile, in der das Wort enthalten ist, in eine neue Excel-Datei zu kopieren? Das soll bei allen 17tausend(!) Zeilen geschehen!

Vielen Dank für Deine Hilfe!

Grüße!

Reinhard_fb8cb7 · 10. November 2019 um 11:28

Hi Julius,

vielen Dank! Soweit funktioniert es jetzt. Allerdings hat sich
ein neuer Fehler herausgestellt…

zeige mal den aktuellen Code nach Einbau der Änderungen von Manfred, damit wir vom gleichen Code reden können.

Die importierten txt Dateien sind nicht identisch, daher kann
ich nicht mit der Filterfunktion arbeiten. Daraus entsteht für
mich die Frage, ob es die Möglichkeit gibt, nach dem Wort
„???“ zu suchen und die ganze Zeile, in der das Wort
enthalten ist, in eine neue Excel-Datei zu kopieren?

Steht das Wort immer in einer Spalte oder kann es überall in der Zeile stehen?

Steht das Wort allein in einer Zelle oder steht es irgendwo im Text der Zelle?

Gruß
Reinhard

Salsero · 10. November 2019 um 11:29

Ich würde die Textdateien als solche zum lesen öffnen (dh nicht importieren) und mit Hilfe von ReadLine Zeile um Zeile auslesen.
Die ausgelesene String kann dann mit InStr(GeleseneZeile, „???“) getestet werden.
Dann entweder die String gleich aufteilen in Felder und in Excel wegschreiben oder sequentiell in einer neuen Textdatei schrieben, die mann dann nach Abarbeitung aller zu scannenden Textdateien als ganzes in Excel importieren kann.

Grüsse,

Salsero

Julius_27759b · 10. November 2019 um 11:31

Klingt in der Theorie gut. So könnte es funktionieren, wobei ich den Import bereits habe. Leider ist der Quellcode im Büro, kann ihn nicht online stellen.

Könntest du mir deine Idee soweit schreiben, dass ich ihn nur einfügen muss? Bin in VBA leider Anfänger.

Ich danke euch!

Julius_27759b · 10. November 2019 um 11:31

Hi Julius,

vielen Dank! Soweit funktioniert es jetzt. Allerdings hat sich
ein neuer Fehler herausgestellt…

zeige mal den aktuellen Code nach Einbau der Änderungen von
Manfred, damit wir vom gleichen Code reden können.

Die importierten txt Dateien sind nicht identisch, daher kann
ich nicht mit der Filterfunktion arbeiten. Daraus entsteht für
mich die Frage, ob es die Möglichkeit gibt, nach dem Wort
„???“ zu suchen und die ganze Zeile, in der das Wort
enthalten ist, in eine neue Excel-Datei zu kopieren?

Steht das Wort immer in einer Spalte oder kann es überall in
der Zeile stehen?

Es steht irgendwo innerhalb von 3 Spalten…

Steht das Wort allein in einer Zelle oder steht es irgendwo im
Text der Zelle?

Es steht alleine in der Spalte aber neben 6 anderen Spalten, die mitkopiert werden müssen.

Gruß
Reinhard

Salsero · 10. November 2019 um 11:31

Werde es morgen zusammenschreiben - habe meine Bausteine nicht hier zu Hause.

In welcher Form möchtest Du den Ergebnisdatei haben ? Als Textdatei, der nur die Zeilen der Ausgangsdateien mit „???“ enthält ?

Du hast auch noch geschrieben, dass die Quelldateien unterschiedlicher Aufbau sind. Haben die alle einen Header ? Wenn ja, und wenn viele der Header-Felder gleich benannt sind, lässt sich die Ergebis-Datei auch noch uniform gestalten, dh sie könnte als Header alle in den Quelldateien vorhandenen Header-Felder kriegen …

Grüsse,

Salsero

Julius_27759b · 10. November 2019 um 11:32

Werde es morgen zusammenschreiben - habe meine Bausteine nicht
hier zu Hause.

VIELEN DANK!

In welcher Form möchtest Du den Ergebnisdatei haben ? Als
Textdatei, der nur die Zeilen der Ausgangsdateien mit „???“
enthält ?

richig! Das wäre perfekt.

Du hast auch noch geschrieben, dass die Quelldateien
unterschiedlicher Aufbau sind. Haben die alle einen Header ?
Wenn ja, und wenn viele der Header-Felder gleich benannt sind,
lässt sich die Ergebis-Datei auch noch uniform gestalten, dh
sie könnte als Header alle in den Quelldateien vorhandenen
Header-Felder kriegen …

Sie sind alle gleich aufgebaut, aber beim Import von Excel verschieben sich mehrere Spalten. Allerdings stellt das kein Problem dar. Alle haben einen Header von 1 Zeile aber dieser muss nur einmal angeziegt werden. Verschiebungen sind nicht schlimm…

Grüsse,

Salsero

Salsero · 10. November 2019 um 11:33

Anbei der Kode - viel Spass damit

Sub ScanFiles()
Dim testbool, headerbool As Boolean
Dim MyPath, Filename, ResultsFileName, Pattern, GeleseneZeile As String
'==========
Pattern = "JobList20080???.txt"
ResultsFileName = "ResultsFileScanning.txt" 'die Ergebisdatei wird im gleichen Verzeichnis wie die Quelldateien gespeichert
' ========= entweder
MyPath = "Y:\JobList\"
' ========= oder
With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 .Show
 MyPath = .SelectedItems(1) & "\"
End With
' ==========
headerbool = True
Set fso = CreateObject("Scripting.FileSystemObject")
testbool = fso.fileexists(MyPath & ResultsFileName)
If testbool Then Kill MyPath & ResultsFileName
Filename = Dir(MyPath & Pattern)
If Filename = "" Then
 response = MsgBox("Keine Dateien vom Typ " & Pattern & " gefunden", vbOKOnly)
 Exit Sub
End If
Set g = fso.CreateTextFile(MyPath & ResultsFileName)
Do
 Set f = fso.OpenTextFile(MyPath & Filename)
 Do
 On Error Resume Next
 GeleseneZeile = f.ReadLine
 If Err.Number 0 Then
 On Error GoTo 0
 Exit Do
 End If
 On Error GoTo 0
 If Len(Trim(GeleseneZeile)) \> 0 Then
 If InStr(GeleseneZeile, "????") \> 0 Or headerbool Then
 g.WriteLine (GeleseneZeile)
 If headerbool Then headerbool = False
 End If
 End If
 Loop
 f.Close
 Filename = Dir
 If Filename = "" Then Exit Do
Loop
g.Close
End Sub

[MOD] - Pre-Tag eingefügt.

Reinhard_fb8cb7 · 10. November 2019 um 11:33

OT Dim

Dim testbool, headerbool As Boolean

Hi Salsero,

nicht richtig wichtig aber wenn du glaubst testbool hätte den Variablentyp Boolean liegst du falsch, es ist Variant.

So gehts:

Dim testbool As Boolean, headerbool As Boolean

Gruß
Reinhard

Salsero · 10. November 2019 um 11:33

nicht richtig wichtig aber wenn du glaubst testbool hätte den
Variablentyp Boolean liegst du falsch, es ist Variant.

Oops, da habe ich geschlammpt Danke !