@ Franz
16.06.2008 09:08:00
christian
Hallo,
schon mal danke für deine Lösung.
Ich habe deinen ode ausprobiert und das kommt raus wenn ichs laufen lasse:
Leider kann ich den Code nicht interpretieren, deshalb meine Frage:
Das Format der Zeitanzeigen in der Box ist mir etwas unverständlich.
Einfacher wäre es für mich wenn er in jeder einzelnen Datei die Zeitdiffernzen ("Aus - Ein") mißt (oder macht er dies bereits?) und diese Differenzen dann für alle Dateien im Verzeichnis aufaddiert und mir die Differenz (Betriebszeit) anzeigt.
Optional:
ich habe von Erich mal einen Code für einen Startzähler bekommen. Der schreibt mir die Anzahl Startvorgänge der jeweiligen Datein in eine Excel-Tabelle, könnte man das vielleicht für meinen Betriebsstundenzähler modifizieren?
CODE:
Option Explicit
Sub Start()
Dim strV As String, strE As String, lngUeb As Long, strSpalte As String
Dim lngZ As Long, intDreh As Integer
strE = "xls"
lngUeb = 2
strSpalte = "D"
strV = Cells(2, 2)
If strV = "" Then Exit Sub
If Right(strV, 1) = "\" Then strV = Left(strV, Len(strV) - 1)
If Dir(strV & "\*.xls") = "" Then
MsgBox "Keine xls-Datei gerfunden in" & vbLf & vbLf & strV
Exit Sub
End If
ListFiles strV, strE
Cells.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Cells(1, 5) = "Starts"
For lngZ = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(lngZ, 1) ThisWorkbook.Name Then
Cells(lngZ, 5) = _
ZaehleStarts(strV & "\" & Cells(lngZ, 1), lngUeb + 1, strSpalte, intDreh)
End If
Next lngZ
Columns("A:F").AutoFit
End Sub
Sub ListFiles(strVrz As String, strEndg As String)
Dim FSO As Object, oFolder As Object, oFile As Object
Dim arr As Variant, lngZ As Long, lngS As Long
On Error GoTo ERRORHANDLER
strEndg = UCase(strEndg)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(strVrz)
arr = Array("Name", "Erstellung", "Letzte Änd.", "Bytes")
Workbooks.Add 1
Rows(1).HorizontalAlignment = xlCenter
Range(Cells(1, 1), Cells(1, UBound(arr) + 1)) = arr
lngZ = 1
For Each oFile In oFolder.Files
If strEndg = UCase(FSO.GetExtensionName(oFile)) Then
lngZ = lngZ + 1
Cells(lngZ, 1).Value = oFile.Name
Cells(lngZ, 2).Value = oFile.DateCreated
Cells(lngZ, 3).Value = oFile.DateLastModified
Cells(lngZ, 4).Value = oFile.Size
End If
Next oFile
ERRORHANDLER:
If Err > 0 Then
MsgBox "Die Dateien konnten nicht gelistet werden!"
MsgBox "Fehler " & Err.Number & vbLf & Err.Description
End If
Set FSO = Nothing
Set oFolder = Nothing
Set oFile = Nothing
End Sub
Function ZaehleStarts(strFile As String, lngU As Long, strSp As String, _
intVor As Integer)
Dim intErg As Integer, lngZ As Long, lngS As Long
Application.EnableEvents = False
' On Error GoTo ERRORHANDLER1
Workbooks.Open strFile, 0, True
' On Error GoTo ERRORHANDLER2
Worksheets(1).Select
lngS = Range(strSp & "1").Column
If intVor = 1000 Then intErg = 1
lngZ = Cells(Rows.Count, lngS).End(xlUp).Row
If lngZ > lngU Then
ZaehleStarts = intErg + Evaluate("SUMPRODUCT((" & strSp & lngU & ":" & strSp & _
lngZ - 1 & "1000))")
intVor = Cells(lngZ, lngS)
Else
ZaehleStarts = "Weniger als 2 Datenzeilen"
End If
ERRORHANDLER2:
ActiveWorkbook.Close False
ERRORHANDLER1:
If Err > 0 Then ZaehleStarts = "Fehler " & Err.Number
Application.EnableEvents = True
End Function
christian
