Infos aus Dateien automatisch zusammenfassen im Ex

Wie kann ich aus mehreren Text-Dokumente denn Werte ab einen bestimmten Punkt ins Excel automatisch importieren lasen.
Ausgangslage:
Habe von jedem PC ein Log- respektive TXT- File mit diversen Informationen.
PC-NB-01.txt
PC-NB-02.txt
PC-NB-03.txt
Jetzt will ich die Installierte Software in ein Excel-Blatt zusammen führen.
Ziel ist es eine Auflistung zu erstellen siehe Beispiel :
Userbild

Der Punkt im Logfile wo ausgelesen werden soll beginnt immer mit: [Installed Software] und endet bei [Running Tasks].
Die Informationen zwischen diesen zwei Schlüsselwörter sollte automatisch ausgelesen und in die Tabellen eingetragen werden.
[Installed Software]
Windows XP Hotfix - KB873339
Microsoft .NET Framework 1.1
Microsoft Office XP
WinZip 8.1
u.s.w.....
[Running Tasks]

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Text_Import() Dim i As Integer Dim startflag As Boolean Dim endeflag As Boolean 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" startflag = False endeflag = False 'Dialogfenster Öffnen sFile = Application.GetOpenFilename _ ("txt-Dateien (*.txt), *.txt") If sFile <> False Then Close Open sFile For Input As #1 Cells(1, 1).Value = sFile i = 2 Do While Not EOF(1) Line Input #1, strtxt If startflag And Not endeflag Then Cells(i, 1).Value = strtxt i = i + 1 End If If Left(strtxt, 20) = "[Installed Software]" Then startflag = True If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True Loop Close End If End Sub

Private Sub Text_Import_alle() Dim i As Integer Dim zeile As Integer Dim startflag As Boolean Dim endeflag As Boolean Dim pfadfile As String Dim fileart As String 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" startflag = False endeflag = False pfadfile = "c:\temp\" fileart = "*.txt" 'Start der Verarbeitung zeile = 1 fn = Dir(pfadfile & fileart) Do While fn <> "" Open fn For Input As #1 Cells(zeile, 1).Value = fn i = 2 Do While Not EOF(1) Line Input #1, strtxt If startflag And Not endeflag Then Cells(zeile, i).Value = strtxt i = i + 1 End If If Left(strtxt, 20) = "[Installed Software]" Then startflag = True If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True Loop Close zeile = zeile + 1 Loop End Sub

Private Sub Text_Import_alle() Dim i As Integer Dim zeile As Integer Dim startflag As Boolean Dim endeflag As Boolean Dim pfadfile As String Dim fileart As String 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" pfadfile = "c:\temp\" fileart = "*.txt" 'Start der Verarbeitung zeile = 1 fn = Dir(pfadfile & fileart) Do While fn <> "" startflag = False endeflag = False Open fn For Input As #1 Cells(zeile, 1).Value = fn i = 2 Do While Not EOF(1) Line Input #1, strtxt If startflag And Not endeflag Then Cells(zeile, i).Value = strtxt i = i + 1 End If If Left(strtxt, 20) = "[Installed Software]" Then startflag = True If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True Loop Close zeile = zeile + 1 Loop End Sub

Private Sub Text_Import_alle() Dim i As Integer Dim zeile As Integer Dim startflag As Boolean Dim endeflag As Boolean Dim pfadfile As String Dim fileart As String 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" pfadfile = "c:\temp\" fileart = "*.txt" 'Start der Verarbeitung zeile = 1 fn = Dir(pfadfile & fileart) Do While fn <> "" startflag = False endeflag = False Open fn For Input As #1 Cells(zeile, 1).Value = fn i = 2 Do While Not EOF(1) Line Input #1, strtxt If startflag And Not endeflag Then Cells(zeile, i).Value = strtxt i = i + 1 End If If Left(strtxt, 20) = "[Installed Software]" Then startflag = True If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True Loop Close zeile = zeile + 1 fn = Dir() Loop End Sub

Sub Text_Import_alle() Dim zeile As Integer Dim startflag As Boolean Dim endeflag As Boolean Dim pfadfile As String Dim fileart As String Dim myarray(100) As String Dim y As Integer Dim done As Boolean 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" pfadfile = "c:\temp\" fileart = "*.txt" 'Start der Verarbeitung zeile = 1 fn = Dir(pfadfile & fileart) Do While fn <> "" startflag = False endeflag = False Open fn For Input As #1 Cells(zeile, 1).Value = fn Do While Not EOF(1) Line Input #1, strtxt If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True If startflag And Not endeflag Then ' spalte ermitteln über temp. array done = False For y = 0 To 99 If myarray(y) = "" Or IsNull(myarray(y)) Then Exit For If myarray(y) = strtxt Then done = True Exit For End If Next y If Not done Then myarray(y) = strtxt 'in array eintragen Cells(zeile, y + 2).Value = strtxt ' in sheet eintragen End If If Left(strtxt, 20) = "[Installed Software]" Then startflag = True Loop Close zeile = zeile + 1 fn = Dir() Loop End Sub

Sub Text_Import_alle() Dim zeile As Integer Dim startflag As Boolean Dim endeflag As Boolean Dim pfadfile As String Dim fileart As String Dim myarray(100) As String Dim y As Integer Dim done As Boolean 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" pfadfile = "c:\temp\" fileart = "*.txt" 'Start der Verarbeitung zeile = 1 fn = Dir(pfadfile & fileart) Do While fn <> "" startflag = False endeflag = False Open fn For Input As #1 Cells(zeile, 1).Value = fn Do While Not EOF(1) Line Input #1, strtxt If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True If startflag And Not endeflag Then ' spalte ermitteln über temp. array done = False For y = 0 To 99 If myarray(y) = "" Or IsNull(myarray(y)) Then Exit For If myarray(y) = UCase(strtxt) Then done = True Exit For End If Next y If Not done Then myarray(y) = UCase(strtxt) 'in array eintragen Cells(zeile, y + 2).Value = strtxt ' in sheet eintragen End If If Left(strtxt, 20) = "[Installed Software]" Then startflag = True Loop Close zeile = zeile + 1 fn = Dir() Loop 'SummenZeile bilden Dim anz As Integer Dim i As Integer Cells(zeile, 1).Value = "Anzahl" For y = 2 To 101 anz = 0 For i = 1 To zeile - 1 If Cells(i, y) <> "" Then anz = anz + 1 Next i If anz > 0 Then Cells(zeile, y).Value = anz Next y End Sub

Sub Text_Import_alle() Dim zeile As Integer Dim spalte As Integer Dim startflag As Boolean Dim endeflag As Boolean Dim pfadfile As String Dim fileart As String Dim myarray() As String Dim y As Integer Dim done As Boolean 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" pfadfile = "c:\temp\" fileart = "*.txt" 'Start der Verarbeitung zeile = 1 spalte = 254 'Anzahl Spalten 0..254 (mehr kann Excel NICHT!) ReDim myarray(spalte) fn = Dir(pfadfile & fileart) Do While fn <> "" startflag = False endeflag = False Open fn For Input As #1 Cells(zeile, 1).Value = fn Do While Not EOF(1) Line Input #1, strtxt If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True If startflag And Not endeflag Then ' spalte ermitteln über temp. array done = False For y = 0 To spalte - 1 If myarray(y) = "" Or IsNull(myarray(y)) Then Exit For If myarray(y) = UCase(strtxt) Then done = True Exit For End If Next y If Not done And y >= spalte Then MsgBox "Zu wenig Excel-Spalten! " Cells(zeile, y + 2).Value = Cells(zeile, y + 2).Value & "/" & _ strtxt ' in sheet eintragen End If If Not done And y < spalte Then myarray(y) = UCase(strtxt) 'in array eintragen Cells(zeile, y + 2).Value = strtxt ' in sheet eintragen End If End If If Left(strtxt, 20) = "[Installed Software]" Then startflag = True Loop Close zeile = zeile + 1 fn = Dir() Loop 'SummenZeile bilden Dim anz As Integer Dim i As Integer Cells(zeile, 1).Value = "Anzahl" For y = 2 To spalte + 1 anz = 0 For i = 1 To zeile - 1 If Cells(i, y) <> "" Then anz = anz + 1 Next i If anz > 0 Then Cells(zeile, y).Value = anz Next y End Sub

Hallo ede
So habe diverse Tests gemacht. Das Script von heuet gibt mir den Fehler (Zu Wenig Excel Spalten) zurück. Wie Du es gesagt hast mehr wie 256.
Ich habe dann mit ein zwei Datensätze und dem Script von gestern experimentiert und habe den Fehler gefunden warum diese Differenz entsteht.
1. Es hatte mehrere gleiche Einträge. Da das Script nur einen Eintrag pro Computer setzt, entstand hier mal eine Differenz was so auch richtig ist. Die Ursache der doppelten Einträge kommt aus der Registry wo ausgelesen wird für das Loglife.
2. Bei genau dem 100dersten Eintrag wurden keine weiteren Werte mehr eingetragen.
Ich habe an der falschen Stelle versucht den Wert zu Korrigieren [Dim myarray(200)].
Habe dann die Stelle gefunden und auf 180 erhöht:
' spalte ermitteln über temp. array
done = False
For y = 0 To 180
Da waren dann auch die Fehlende Einträge.
Diese Script von gestern währe die Lösung, wenn er jetzt die Einträge in die Zeilen schreibt schreiben würde, statt wie bisher in die Spalten. Dann hätte man auch nicht mehr das Problem von den max. 256 Spalten.
Noch eine Frage: Habe gesehen das beim dem letzten Script der Wer hier von 200 nicht mehr vorhanden ist [Dim myarray(200) As String]. Was hatte dieser Wert für eine Bedeutung?
Gruss Hans


Sub Text_Import_alle()
Dim zeile As Integer
Dim startflag As Boolean
Dim endeflag  As Boolean
Dim pfadfile As String
Dim fileart As String
Dim myarray(200) As String
Dim y As Integer
Dim done As Boolean
'StartVerzeichnis - bitte anpassen
ChDrive "c:\"
ChDir "\temp"
pfadfile = "c:\temp\"
fileart = "*.txt"
'Start der Verarbeitung
zeile = 1
fn = Dir(pfadfile & fileart)
Do While fn <> ""
startflag = False
endeflag = False
Open fn For Input As #1
Cells(zeile, 1).Value = fn
Do While Not EOF(1)
Line Input #1, strtxt
If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True
If startflag And Not endeflag Then
' spalte ermitteln über temp. array
done = False
For y = 0 To 180
If myarray(y) = "" Or IsNull(myarray(y)) Then Exit For
If myarray(y) = strtxt Then
done = True
Exit For
End If
Next y
If Not done Then myarray(y) = strtxt    'in array eintragen
Cells(zeile, y + 2).Value = strtxt      ' in sheet eintragen
End If
If Left(strtxt, 20) = "[Installed Software]" Then startflag = True
Loop
Close
zeile = zeile + 1
fn = Dir()
Loop
End Sub

Sub Text_Import_alle2Zeilen() Dim zeile As Integer Dim spalte As Integer Dim startflag As Boolean Dim endeflag As Boolean Dim pfadfile As String Dim fileart As String Dim myarray() As String Dim y As Integer Dim done As Boolean 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" pfadfile = "c:\temp\" fileart = "*.txt" 'Start der Verarbeitung zeile = 1 spalte = 999 'hier Anzahl anpassen ReDim myarray(spalte) fn = Dir(pfadfile & fileart) Do While fn <> "" startflag = False endeflag = False Open fn For Input As #1 Cells(1, zeile).Value = fn Do While Not EOF(1) Line Input #1, strtxt If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True If startflag And Not endeflag Then ' spalte ermitteln über temp. array done = False For y = 0 To spalte - 1 If myarray(y) = "" Or IsNull(myarray(y)) Then Exit For If myarray(y) = UCase(strtxt) Then done = True Exit For End If Next y If Not done And y = spalte Then MsgBox "Die Variable Spalte im Script erhöhen und nochmal laufen lassen! ABBRUCH" Exit Sub End If If Not done Then myarray(y) = UCase(strtxt) 'in array eintragen End If Cells(y + 2, zeile).Value = strtxt ' in sheet eintragen End If If Left(strtxt, 20) = "[Installed Software]" Then startflag = True Loop Close zeile = zeile + 1 fn = Dir() Loop End Sub

Sub Text_Import_alle() Dim zeile As Integer Dim spalte As Integer Dim startflag As Boolean Dim endeflag As Boolean Dim pfadfile As String Dim fileart As String Dim myarray() As String Dim y As Integer Dim done As Boolean 'StartVerzeichnis - bitte anpassen ChDrive "c:\" ChDir "\temp" pfadfile = "c:\temp\" fileart = "*.txt" 'Start der Verarbeitung zeile = 1 spalte = 254 'Anzahl Spalten 0..254 (mehr kann Excel NICHT!) ReDim myarray(spalte) fn = Dir(pfadfile & fileart) Do While fn <> "" startflag = False endeflag = False Open fn For Input As #1 Cells(zeile, 1).Value = fn Do While Not EOF(1) Line Input #1, strtxt If Left(strtxt, 15) = "[Running Tasks]" Then endeflag = True If startflag And Not endeflag Then ' spalte ermitteln über temp. array done = False For y = 0 To spalte - 1 If myarray(y) = "" Or IsNull(myarray(y)) Then Exit For If myarray(y) = UCase(strtxt) Then done = True Exit For End If Next y If Not done And y >= spalte Then 'MsgBox "Zu wenig Excel-Spalten! " Cells(zeile, y + 2).Value = Cells(zeile, y + 2).Value & "/" & _ strtxt ' in sheet eintragen End If If Not done And y < spalte Then myarray(y) = UCase(strtxt) 'in array eintragen Cells(zeile, y + 2).Value = strtxt ' in sheet eintragen End If If done Then Cells(zeile, y + 2).Value = strtxt ' in sheet eintragen End If If Left(strtxt, 20) = "[Installed Software]" Then startflag = True Loop Close zeile = zeile + 1 fn = Dir() Loop 'SummenZeile bilden Dim anz As Integer Dim i As Integer Cells(zeile, 1).Value = "Anzahl" For y = 2 To spalte + 1 anz = 0 For i = 1 To zeile - 1 If Cells(i, y) <> "" Then anz = anz + 1 Next i If anz > 0 Then Cells(zeile, y).Value = anz Next y End Sub

Beliebteste Forumthreads (12 Monate)

Infos aus Dateien automatisch zusammenfassen im Ex

33
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Infos aus Dateien automatisch zusammenfassen im Ex

33 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

33
Beiträge zum Forumthread

Beiträge zu diesem Forumthread