AW: Wie lange ist eine Datei/aktuelle Datei offen
08.09.2008 16:42:31
fcs
Hallo Urmila,
wenn du es korrekt gemacht hast, dann zeigt die Message-Box in Minuten:Sekunden an, wie lange die Datei schon geöffnet ist in der du das Makro gespeichert hast.
Wichtig ist, dass du auch unter DieseArbeitsmappe die Prozedur eingefügt hast, die die Uhrzeit beim Öffnen der Datei in der Variablen speichert.
Der zweite Code mit Prozedur "geoeffnet" muss in einem allgemeinen Modul gespeichert werden, sonst funktioniert die Zuweisung der Startzet nicht korrekt.
Wenn du die Prozedur "geoeffnet" per Commandbutton starten willst, dann etwa so:
Private Sub CommandButton1_Click()
Call geoeffnet
End Sub
Oder du verwendest den Commandbutton aus der Symbolleiste Formular und weist ihm das Makro "geoeffnet" zu.
Auf diese weise kannst du den Geöffnet-Zeitraum einer Datei gezielt abfragen, indem du diese Prozeduren alle in der entsprechendne Datei speicherst.
Wie schon in der letzten Antwort geschrieben ist die Überwachung des Geöffnet-Status aller Arbeitsmappen wesentlich komplizierter. Nachfolgend der Beispiel-Code, den du dann in deiner Persönlichen Makroarbeitsmappe speichern muss, damit es funktioniert.
Gruß
Franz
'############## Prozeduren unter Diese Arbeitsmappe ##############
'Beobachtung des Geöffnet-Zeitpunkts von Arbeitsmappen
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call TimeropenStop
End Sub
Private Sub Workbook_Open()
Call TimeropenStart
End Sub
'############## Prozeduren in einem allgemeinen Modul ###########
'Deklaration der modulweiten Variablen
Private TimerStart As Date 'Zeitpunkt der nächsten Ausführung der Prozedur
Private arrWorkbooks() As String 'Array für Namen der geöffneten Arbeitsmappen
Private arrTimeOpend() As Date 'Array für Datum/Uhrzeit des Öffnens der Arbeitsmappen
Sub TimeropenStop()
'Timer zum Verfolgen der Geöffnet-Zeit stoppen
On Error Resume Next
Application.OnTime EarliestTime:=TimerStart, Procedure:="TimerOpen", Schedule:=False
End Sub
Sub TimeropenStart()
'Timer zum Verfolgen der Geöffnet-Zeit starten
Call FelderInitialisieren
Call TimerOpen
End Sub
Sub TimerOpen()
'Prozedur, die rekursiv aufgerufen wird um geöffneten Arbeitsmappen zu prüfen
Call Pruefenworkbooks
'Alle 5 Sekunden per Timer diese Prozedur erneut starten
'Geöffnet-Zeitpunkt einer Datei wird mit max. 5 Sekunden Verzögerung erfasst.
TimerStart = Now + TimeSerial(Hour:=0, Minute:=0, Second:=5) 'gg. Zeit anpassenf
Application.OnTime EarliestTime:=TimerStart, Procedure:="TimerOpen"
End Sub
Private Sub FelderInitialisieren()
'Prozedur zum Initialisieren der Datenarrays beim Starten von Excel
Dim intI As Integer
If Workbooks.Count = 0 Then
ReDim arrWorkbooks(1 To 1)
ReDim arrTimeOpend(1 To 1)
Else
ReDim arrWorkbooks(1 To Workbooks.Count)
ReDim arrTimeOpend(1 To Workbooks.Count)
For intI = 1 To Workbooks.Count
arrWorkbooks(intI) = Workbooks(intI).Name
arrTimeOpend(intI) = Now
Next
End If
End Sub
Private Sub Pruefenworkbooks()
Dim intI As Integer, bolGeschlossen As Boolean, bolNeu As Boolean, wb As Workbook
'geschlossene Workbooks in Array auf "" setzen
For intI = 1 To UBound(arrWorkbooks())
bolGeschlossen = True
For Each wb In Workbooks
If wb.Name = arrWorkbooks(intI) Then
bolGeschlossen = False
Exit For
End If
Next
If bolGeschlossen = True Then
arrWorkbooks(intI) = ""
End If
Next
'neu geöffnete Workbooks in Array aufnehmen
For Each wb In Workbooks
bolNeu = True
For intI = 1 To UBound(arrWorkbooks())
If wb.Name = arrWorkbooks(intI) Then
bolNeu = False
Exit For
End If
Next
If bolNeu = True Then
'Arrays neu dimensionieren
ReDim Preserve arrWorkbooks(1 To UBound(arrWorkbooks) + 1)
ReDim Preserve arrTimeOpend(1 To UBound(arrWorkbooks) + 1)
'Daten ins Array schreiben
arrWorkbooks(UBound(arrWorkbooks)) = wb.Name
arrTimeOpend(UBound(arrWorkbooks)) = Now
End If
Next
End Sub
Sub GeoeffnetAktiv()
'Anzeigen für aktive Arbeitsmappe
Call ZeitGeoeffnetMappe("")
End Sub
Sub GeoeffnetMappe1()
'Anzeigen für Arbeitsmappe "Mappe1.xls"
Call ZeitGeoeffnetMappe("Mappe1.xls")
End Sub
Private Sub ZeitGeoeffnetMappe(strMappe As String)
Dim intI As Integer, DauerGeoeffnet As Date
'Geöffnet-Zeit der Arbeitsmappe anzeigen
If strMappe = "" Then strMappe = ActiveWorkbook.Name
For intI = 1 To UBound(arrWorkbooks())
If LCase(strMappe) = LCase(arrWorkbooks(intI)) Then
DauerGeoeffnet = Now - arrTimeOpend(intI)
MsgBox "Datei " & strMappe & " ist " & Mid(Format(DauerGeoeffnet, "hh:mm:ss"), 4) _
& " (mm:ss) geöffnet"
Exit For
End If
Next
End Sub