neue Version 2
29.03.2006 11:03:56
ede
habe noch einen möglichen fehler bereinigt!
rückmeldung wäre supppppper!
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