Windows arbeitet intern mit einem Taktgeber im Millisekundenbereich, also sehr viel genauer als VBA. Allerdings ist Windows standardmäßig so eingestellt, dass der Zeitgeber nur alle 15,7 Millisekunden ausgelöst wird. Die folgenden Angaben zum Arbeiten im Millisekundenbereich sind also mit Vorsicht zu sehen.
Es gibt Freeware, mit der man kürzere Intervalle einstellen kann, und auch einige Computerspiele stellen kürzere Werte ein. Dabei ist aber zu berücksichtigen, dass angeblich damit der Stromverbrauch des PCs steigt - teilweise sogar drastisch.
Liefert die Uhrzeit gemäß der lokalen Zeitzone des Computers.
Die kleinste Zeiteinheit der VBA-internen
Datumsfunktionen ist eine Sekunde, lediglich
Timer liefert noch Hundertstelsekunden
als Nachkommastellen vom Typ Single. GetLocalTime gibt dagegen auch
Tausendstelsekunden zurück, und zwar als ganze Stellen.
GetLocalTime liefert u. a. auch den Wochentag als Zahl von
0 bis 6, wobei mit dem Sonntag begonnen wird. Das ist anders als bei der VBA-internen
Auflistung VbDayOfWeek.
Die folgende Beispielfunktion demoTimer gibt ein ähnliches Ergebnis
zurück wie Timer, allerdings um eine Stelle
genauer und mal 1000 - soweit der Zeitgeber des Computers entsprechend eingestellt
sein sollte.
#If VBA7 Then Private Declare PtrSafe Sub GetLocalTime Lib "kernel32" _ (lpSystemTime As SYSTEMTIME) #Else Private Declare Sub GetLocalTime Lib "kernel32" _ (lpSystemTime As SYSTEMTIME) #End If Private Type SYSTEMTIME wYear As Integer wMonth As Integer ' 1 = Januar, ..., 12 = Dezember wDayOfWeek As Integer ' 0 = Sonntag, 1 = Montag, ..., 6 = Samstag wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type
Public Function demoTimer() As Long Dim z As SYSTEMTIME GetLocalTime z demoTimer = z.wMilliseconds _ + (z.wSecond + (z.wMinute * 60) + (CLng(z.wHour) * 3600)) * 1000 End Function
GetSystemTime ist mit GetLocalTime
identisch, liefert aber nicht die lokale Zeitzone, sondern die UTC-Zeit (Greenwich).
#If VBA7 Then Private Declare PtrSafe Sub GetSystemTime Lib "kernel32" _ (lpSystemTime As SYSTEMTIME) #Else Private Declare Sub GetSystemTime Lib "kernel32" _ (lpSystemTime As SYSTEMTIME) #End If Private Type SYSTEMTIME wYear As Integer wMonth As Integer ' 1 = Januar, ..., 12 = Dezember wDayOfWeek As Integer ' 0 = Sonntag, 1 = Montag, ..., 6 = Samstag wDay As Integer wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type
Public Function demoSysTime() As String Dim z As SYSTEMTIME GetSystemTime z demoSysTime = z.wDayOfWeek & "; " _ & z.wDay & "." & z.wMonth & "." & z.wYear & " " _ & z.wHour & ":" & z.wMinute & ":" & z.wSecond & "," & z.wMilliseconds End Function
Gibt die Anzahl der Millisekunden seit dem Systemstart zurück.
#If Win64 Then Public Declare PtrSafe Function GetTickCount _ Lib "kernel32" Alias "GetTickCount64" () As LongLong #Else Public Declare Function GetTickCount _ Lib "kernel32" () As Long #End If
Genau genommen, werden hier zwei verschiedene API-Prozeduren angesprochen: Für
64-Bit Office das neuere GetTickCount64, und für 32-Bit Office das
ältere GetTickCount. Beide Prozeduren sind im Grunde identisch, allerdings
gibt GetTickCount einen Long-Wert zurück. Läuft ein System ununterbrochen
länger als knapp 25 Tage, erreicht GetTickCount das Maximum der mit
Long darstellbaren Zahl und die Funktion zählt dann von -2.147.483.648 aufwärts,
bis nach weiteren knapp 50 Tagen abermals auf -2.147.483.648 zurückgesetzt wird.
GetTickCount64 verwendet dagegen LongLong, so dass dieser
Punkt erst nach Jahrmillionen erreicht wäre.
Auch ein 32-Bit Office ab Office 2010 (VBA7) könnte unter einem 64-Bit Windows
GetTickCount64 nutzen. Der Rückgabewert muss dann den Typ LongPtr
haben. Da LongPtr unter 32-Bit aber als Long interpretiert
wird, wäre damit nichts gewonnen. Daher ist GetTickCount64 erst mit
einem 64-Bit Office sinnvoll, weswegen hier mit Win64 geprüft wird.
Der Rückgabewert zeigt an, ob gerade Sommerzeit ist oder nicht. Außerdem wird eine Struktur zurückgegeben, die anzeigt, wann die Sommerzeit beginnt bzw. endet, wie die entsprechenden Zeitzonen heißen und um wie viele Minuten zur UTC diese Zeitzonen jeweils versetzt sind.
#If VBA7 Then Private Declare PtrSafe Function GetTimeZoneInformation _ Lib "kernel32" (l As LPTIME_ZONE_INFORMATION) As Long #Else Private Declare Function GetTimeZoneInformation _ Lib "kernel32" (l As LPTIME_ZONE_INFORMATION) As Long #End If Private Type SYSTEMTIME 'Zeitpunkte der Umschaltung der Sommerzeit wYear As Integer 'Wenn 0, gilt die Sommerzeit für jedes Jahr wMonth As Integer '1 = Januar, ..., 12 = Dezember wDayOfWeek As Integer '0 = Sonntag, 1 = Montag, ..., 6 = Samstag wDay As Integer 'Umschaltung am wievielten wDayOfWeek? (5=Letzter) wHour As Integer wMinute As Integer wSecond As Integer wMilliseconds As Integer End Type Private Type LPTIME_ZONE_INFORMATION Bias As Long 'Abweichung Lokalzeit zu UTC in Minuten StandardName As String * 64 'Bezeichnung der Standardzeit (UTF16-String) StandardDate As SYSTEMTIME 'Zeitpunkt, zu dem die Sommerzeit endet StandardBias As Long 'Zusätzliche Abweichung Standardzeit zu UTC DaylightName As String * 64 'Bezeichnung der Sommerzeit (UTF16-String) DaylightDate As SYSTEMTIME 'Zeitpunkt, zu dem die Sommerzeit beginnt DaylightBias As Long 'Zusätzliche Abweichung Sommerzeit zu UTC End Type 'übliche Rückgabewerte von GetTimeZoneInformation Private Const TIME_ZONE_ID_UNKNOWN = 0 Private Const TIME_ZONE_ID_STANDARD = 1 Private Const TIME_ZONE_ID_DAYLIGHT = 2
Public Sub demoTimeZoneInformation() Dim z As LPTIME_ZONE_INFORMATION Dim lngZone As Long, strTime As String lngZone = GetTimeZoneInformation(z) Select Case lngZone Case TIME_ZONE_ID_UNKNOWN Debug.Print "Unbekannte Zeitzone" Case TIME_ZONE_ID_STANDARD Debug.Print "Derzeit ist Standardzeit" Case TIME_ZONE_ID_DAYLIGHT Debug.Print "Derzeit ist Sommerzeit" Case Else Debug.Print "Ungültige Zeitzoneninformation" Exit Sub End Select Debug.Print "Normabweichung zu UTC: ", z.Bias; "min" Debug.Print "Standardzeitzone:", StrConv(z.StandardName, vbFromUnicode) Debug.Print "Zusatzabweichung zu UTC: ", z.StandardBias&; "min" Debug.Print "Sommerzeitzone:", StrConv(z.DaylightName, vbFromUnicode) Debug.Print "Zusatzabweichung zu UTC: ", z.DaylightBias; "min" With z.DaylightDate If .wDay = 5 Then strTime = "Letzter Wochentag '" Else strTime = .wDay & ". Wochentag '" End If strTime = strTime & .wDayOfWeek & "' im Monat " & Format(.wMonth, "'00'\, ") _ & Format(.wHour, "00:") & Format(.wMinute, "00:") & Format(.wSecond, "00h") End With Debug.Print "Beginn Sommerzeit: ", strTime With z.StandardDate If .wDay = 5 Then strTime = "Letzter Wochentag '" Else strTime = .wDay & ". Wochentag '" End If strTime = strTime & .wDayOfWeek & "' im Monat " & Format(.wMonth, "'00'\, ") _ & Format(.wHour, "00:") & Format(.wMinute, "00:") & Format(.wSecond, "00h") End With Debug.Print "Ende Sommerzeit: ", strTime End Sub
Um nicht nur einfach zu erfahren, ob gerade Sommerzeit ist, sondern auch die Umstellungszeitpunkte, muss man wissen, wie genau diese Termine aus den Angaben in SYSTEMTIME zu ermitteln sind:
Wenn wYear = 0 ist, wiederholt sich die Umschaltregel jährlich.
Dann werden der Monat und die Nummer des Wochentags herangezogen. Der wievielte
Wochentag im Monat relevant ist, entscheidet sich anhand von wDay.
Mit wDay = 5 wird bestimmt, dass es sich um den letzten entsprechenden
Wochentag handelt (Aus Vereinfachungsgründen gibt die obige Prozedur nicht auch
noch den Klarnamen des Wochentags aus, sondern nur die Nummer).
Bias gibt an, um wie viele Minuten die Zeitzone zur UTC-Zeit versetzt
ist. Je nachdem, ob gerade Standard- oder Sommerzeit ist, muss dazu der jeweilige
Bias addiert werden, um die aktuelle Zeitverschiebung zu ermitteln.
demoTimeZoneInformation Derzeit ist Sommerzeit Normabweichung zu UTC: -60 min Standardzeitzone: Mitteleuropäische Zeit Zusatzabweichung zu UTC: 0 min Sommerzeitzone: Mitteleuropäische Sommerzeit Zusatzabweichung zu UTC: -60 min Beginn Sommerzeit: Letzter Wochentag '0' im Monat '03', 02:00:00h Ende Sommerzeit: Letzter Wochentag '0' im Monat '10', 03:00:00h