Office: einzelne Zeile aus Textdateien lesen und mit Dateinamen untereinander schreiben

last_seconds · 27. April 2011

Hallo zusammen,

ich suche ein Makro, welches eine bestimmte Zeile aller in einem Ordner vorkommenden Dateien einliest und mit dem Dateinamen und dem Wert der Zeile untereinander schreibt. Schon eingelesene und gleiche Daten sollen nicht nochmals eingelesen werden.

Die Dateien haben alle die Endung .dcm. Den Wert, den ich gerne in Excel möchte steht immer in Zeile 21 und steht direkt hinter folgenden Ausdruck
" WERT ".

Kann mir dabei bitte jemand helfen? Ich suche schon seit Stunden - habe für dieses spezielle Problem jedoch keinerlei Lösung gefunden.

Schöne Grüße

:)

Scorefun · 29. April 2011

Könnte so aussehen (Allerdings keine prüfung auf bereits eingelesene Dateien...)

Code:

Sub leseVerzeichnis(sDir As String)
Dim sFile As String
Dim sZeile As String
Dim sWert As String
Dim r As Long

r = 2

sFile = Dir(sDir & "\*.dcm")

Do While sFile ""
'Zeile einlesen
sZeile = ReadLine(sDir & "\" & sFile, 21)
'Wert ab 5. Stelle auslesen
sWert = Mid(sZeile, 5)
'Dateiname und Wert in aktives Excel-Sheet schreiben
Range("A" & r) = sDir & "\" & sFile
Range("B" & r) = sWert
'Zeilenzaehler hochsetzen
r = r + 1
'Nächste Datei im verzeichnis
sFile = Dir
Loop

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Funktion ReadLine kommt von hier:
vb@rchiv · Tipps & Tricks · Bestimmte Zeile aus einer Textdatei auslesen
oder
vb@rchiv · Tipps & Tricks · Bestimmte Zeile aus einer Textdatei auslesen II

chris-kaiser · 29. April 2011

hi

ich kann zwar NICHT mit dcm testen!!

Aber für TXT Dateien würde es so gehen (getestet)

Code:

Option Explicit
Sub Zeileeinundzwanzig()
Dim lngZeile As Long, StrFile As String, StrTXT As String, FreeF As Integer, IntC As Integer
lngZeile = 1
'falls diese CMD Dateien änlich sind wie txt müsste es funktionieren Dateiendung auf dcm!!! ändern
StrFile = Dir(ThisWorkbook.Path & "\*.txt") 'oder statt ThisWorkbook.Path eine Fixe Pfadangebe z.B "C:\xxx\"
If StrFile = "" Then MsgBox "In diesem Verzeichnis sind keine Txt-Dateien": Exit Sub
Do Until StrFile = ""
FreeF = FreeFile
Open ThisWorkbook.Path & "\" & StrFile For Input As #FreeF
Do Until EOF(FreeF)
Line Input #FreeF, StrTXT
IntC = IntC + 1
If IntC = 21 Then 'Zeile 21
Exit Do
End If
Loop
Close #FreeF
Range("A" & lngZeile).Value = Replace(StrTXT, " WERT ", "") 'sind da wirklich Leerzeichen vorne und hinten?
StrFile = Dir
lngZeile = lngZeile + 1
IntC = 0
Loop
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

das mit doppelte entfenen habe ich noch nicht eingebaut, wäre aber auch keine hexerei, falls der code mal überhaupt für dcm dateien funktionieren würde.

last_seconds · 29. April 2011

Hallo ihr beiden,

herzlichen Dank.

Es funktioniert jetzt wie folgt:

Code:

Option Explicit
Sub Zeileeinundzwanzig()
Dim lngZeile As Long, StrFile As String, StrTXT As String, FreeF As Integer, IntC As Integer
lngZeile = 1
StrFile = Dir("\\netzlaufwerk" & "\*.dcm")
If StrFile = "" Then MsgBox "In diesem Verzeichnis sind keine Txt-Dateien": Exit Sub
Do Until StrFile = ""
FreeF = FreeFile
Open "\\netzlaufwerk" & "\" & StrFile For Input As #FreeF
Do Until EOF(FreeF)
Line Input #FreeF, StrTXT
IntC = IntC + 1
If IntC = 21 Then 'Zeile 21
Exit Do
End If
Loop
Close #FreeF
Range("A" & lngZeile).Value = Replace(StrTXT, " WERT ", "")
StrFile = Dir
lngZeile = lngZeile + 1
IntC = 0
Loop
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Was nicht klappt, ist das Schreiben des Dateinnamens in Spalte A vor dem Wert nach " WERT " (mit drei Leerzeichen vor und einem nach "Wert").

Es sollte also so aussehen:

A|B
Dateiname|Wert

Habt ihr hierfür vielleicht noch eine Möglichkeit? Es sind übrigens *.DCM- Dateien - keine *.CMD *Smilie

last_seconds · 29. April 2011

*doppelpost*

chris-kaiser · 29. April 2011

Hi

Code:

Range("A" & lngZeile).Value = StrFile
Range("B" & lngZeile).Value = Replace(StrTXT, " WERT ", "")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ist aber wieder mal nicht getestet ^^, sollte mal den Rechner wechseln, ohne Off. ist der irgendwie nackt.

last_seconds · 29. April 2011

Danke, funktioniert prächtig. Wie kann ich dafür sorgen, dass erst ab der zweiten Zeile eingelesen wird?

Office: einzelne Zeile aus Textdateien lesen und mit Dateinamen untereinander schreiben

einzelne Zeile aus Textdateien lesen und mit Dateinamen untereinander schreiben

einzelne Zeile aus Textdateien lesen und mit Dateinamen untereinander schreiben

einzelne Zeile aus Textdateien lesen und mit Dateinamen untereinander schreiben

einzelne Zeile aus Textdateien lesen und mit Dateinamen untereinander schreiben - Similar Threads - einzelne Zeile Textdateien

VBA Makro, einzelne Zellen kopieren und in fortlaufende Zeile einfügen

Pivot - einzelne Zeilen ausblenden

Zeilen von Exceltabelle auf einzelnen PP-Folien verlinken

Tabellenblatt in UserForm anzeigen um einzelne Zeilen in ein weiteres Tabelleblatt zu

ListBox mit mehrspaltiger Tabelle bestücken und einzelne Zeilen löschen

einzelne Zeilen als Datenblatt drucken (Makro?)

einzelne Zeilen werden in Excel-Tabelle nicht gedruckt