Office: (Office 2016) Aktuelle Zeit vom Zeitserver im Internet

edv-master · 1. August 2020

Hallo,

ich wollte nachfragen ob es irgendwie die Möglichkeit gibt die Zeit von einem Zeitserver im Internet abzufragen und für später zwischenzuspeichern?

Habe aktuell das Problem das bestimmte Funktionen nur nach bestimmter Zeit wieder ausgeführt werden dürfen (auf verschiedenen Frontends) - wenn nun allerdings ein User die Zeit auf eine Zeit in der Zukunft manipuliert geht eben bis zu diesem Zeitpunkt auf keinen der Clients diese Funktion nicht mehr....

Ich würde also gerne die Zeit von einem Server im Internet abfragen und eben mit dieser statt mit der Systemzeit arbeiten - geht das irgendwie (Google liefert zwar Funktionen aber irgendwie funktioniert hier kein einziges Beispiel....)

Gruß
Stefan

:)

ebs17 · 3. August 2020

aber irgendwie funktioniert hier kein einziges Beispiel....
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn die Worte wahr sind und Du diese Worte verstehst und so meinst: Warum sollte sich plötzlich etwas ändern?

edv-master · 3. August 2020

Hi Eberhard,

wenn ich das doch nur wüsste, kannst es ja aber selbst mal probieren, hier ei Code den ich so gefunden habe (bei mir geht da nix):

Code:

Option Compare Database
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function WSAStartup Lib "ws2_32.dll" ( _
ByValwVersionRequired As Integer, _
ByRef lpWSAData As WSADATA) As Long
Private Declare Function socket Lib "ws2_32.dll" ( _
ByVal af As Long, _
ByVal lType As Long, _
ByVal protocol As Long) As Long
Private Declare Function connect Lib "ws2_32.dll" ( _
ByVal s As Long, _
ByRef Name As SOCKADDR, _
ByVal namelen As Long) As Long
Private Declare Function htons Lib "ws2_32.dll" ( _
ByVal hostshort As Integer) As Integer
Private Declare Function inet_addr Lib "ws2_32.dll" ( _
ByVal cp As String) As Long
Private Declare Function recv Lib "ws2_32.dll" ( _
ByVal s As Long, _
ByVal buf As String, _
ByVal lLen As Long, _
ByVal flags As Long) As Long
Private Declare Function closesocket Lib "ws2_32.dll" ( _
ByVal s As Long) As Long
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
Private Declare Function GetTimeZoneInformation Lib "kernel32.dll" ( _
ByRef lpTZI As TIME_ZONE_INFORMATION) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Private Const WS_VERSION_REQD As Long = &H101&
Private Const WSADESCRIPTION_LEN As Long = 256
Private Const WSASYS_STATUS_LEN As Long = 128

Private Const AF_INET As Long = 2
Private Const SOCK_STREAM As Long = 1
Private Const IPPROTO_TCP As Long = 6

Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2

Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSADESCRIPTION_LEN
szSystemStatus As String * WSASYS_STATUS_LEN
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Private Type SOCKADDR
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName(31) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(31) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type

Public Function InternetTime() As Date

'Eine Liste der Deutschen Zeitserver findes du hier:
'NTP-Server

Const SERVER_IP As String = "134.169.10.20" 'ptb in Braunschweig

Dim udtData As WSADATA, udtAdresse As SOCKADDR
Dim udtTimeZone As TIME_ZONE_INFORMATION
Dim strTime As String, strRecvData As String * 5
Dim dblTimeStamp As Double
Dim dtmTime As Date
Dim lngStartupReturn As Long, lngSocketReturn As Long
Dim lngConnectReturn As Long, lngReceiveReturn As Long
Dim lngCloseReturn As Long, lngTZIReturn As Long
Dim lngGTCReturn As Long

lngStartupReturn = WSAStartup(WS_VERSION_REQD, udtData)
If lngStartupReturn 0 Then Exit Function

lngSocketReturn = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
If lngSocketReturn > 10000 And lngSocketReturn < 11005 Then Exit Function

udtAdresse.sin_family = AF_INET
udtAdresse.sin_addr = inet_addr(SERVER_IP)
udtAdresse.sin_port = htons(37)
lngConnectReturn = connect(lngSocketReturn, udtAdresse, Len(udtAdresse))
If lngConnectReturn 0 Then Exit Function

lngGTCReturn = GetTickCount()
lngReceiveReturn = recv(lngSocketReturn, strRecvData, Len(strRecvData), 0)
strTime = Left$(strRecvData, lngReceiveReturn)
If lngReceiveReturn 4 Then Exit Function

lngCloseReturn = closesocket(lngSocketReturn)
If lngCloseReturn 0 Then Exit Function

Call WSACleanup

dblTimeStamp = Asc(Mid(strTime, 1, 1)) * 256 ^ 3 + _
Asc(Mid(strTime, 2, 1)) * 256 ^ 2 + _
Asc(Mid(strTime, 3, 1)) * 256 ^ 1 + _
Asc(Mid(strTime, 4, 1)) - 3155673600#

lngTZIReturn = GetTimeZoneInformation(udtTimeZone)

If lngTZIReturn = TIME_ZONE_ID_DAYLIGHT Then
dblTimeStamp = dblTimeStamp - (udtTimeZone.Bias * 60 + _
udtTimeZone.DaylightBias * 60)
Else
dblTimeStamp = dblTimeStamp - udtTimeZone.Bias * 60
End If

lngGTCReturn = Round((GetTickCount - lngGTCReturn) / 1000, 0)
dblTimeStamp = dblTimeStamp + lngGTCReturn
dtmTime = DateAdd("s", dblTimeStamp, DateSerial(2000, 1, 1))

InternetTime = dtmTime

End Function

Public Sub SetDateTime()

Dim dtmNow As Date

dtmNow = InternetTime

If dtmNow 0 Then

' Time = TimeValue(dtmNow) 'Systemuhrzeit synchronisieren
' Date = DateValue(dtmNow) 'Systenkalender synchronisieren

Call MsgBox(Format(dtmNow, "dd.mm.yyyy hh:nn:ss"), vbInformation, "Information")

Else
Call MsgBox("Fehler beim Lesen der Internetzeit.", vbCritical, "Programmabbruch")
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

PS: zu finden da: klick mich

TSchenke · 3. August 2020

Hallo,
hast Du Dir die Funktion mal in Einzelschritten angesehen? Bei mir steigt sie bei der Zeile
Code:

If lngConnectReturn 0 Then Exit Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

aus, der entsprechende Wert ist bei mir -1, was auch immer das bedeutet. Vielleicht gehst Du dem nach, wenn Dir dieser Ansatz am Herzen liegt.
Gruß Thomas

markusxy · 3. August 2020

Die Website ist nicht erreichbar

Wird wohl eher nicht funktionieren *grins *grins

elmar · 3. August 2020

Bei mir klappt der Link zu: Herbers Excel/VBA-Archiv/Sysem vs. Serverzeit

markusxy · 3. August 2020

Na bitte, einfach damit rechnen das der Server nur machmal funktioniert, das sollte doch reichen.

knobbi38 · 3. August 2020

Hallo edv-master,

wenn mit einem Server gearbeitet wird, muß sichergestellt sein, daß alle Clients mit der vom Server bereitgestellten Zeit arbeiten, sonst geht einiges schief.
Der Server wird seinerseit wiederum per NTP-Server Abfrage abgeglichen.

Normale User habe eigentlich nicht das Recht, diese "Systemzeit" zu ändern. Im Übrigen könnte man die Zeitabfrage der NTP-Server einfach durch trennen der Netzverbindung unterbinden. Einfach auf Erreichbarkeit eines NTP-Servers zu prüfen, greift auch nicht, denn die könnten auch mal ausfallen bzw. kurzfristig nicht verfügbar sein.

Ulrich

edv-master · 3. August 2020

Hi Ulrich,

ich möchte eigentlich ja auch nicht die System oder Serverzeit ändern, sondern im Prinzip nur die Zeit vom NTP-Server abfragen und temporär speichern (Textfeld oder ähnlichen) sollte der Server aus irgend einen Grund "offline" sein soll er einfach die Systemzeit nehmen.
Bekomme eigentlich alles hin, nur die zeit vom NTP abholen klappt nicht

PS: zu dem Thema der Server ist "offline" (angesprochen von "markusxy") der im Beispiel verwendet wird, ich habe schon mehrere andere versucht, allerdings immer mit dem selben Ergebnis das es nicht funktioniert (es werden doch nicht alle Server offline gewesen sein.... - werde dann nochmal probieren und noch andere Server versuchen)

edv-master · 3. August 2020

Hallo,

verdammt, ist mein eigenes Problem gewesen, lag daran das ich ca 15-20 Server getestet habe und scheinbar alle offline sind oder mit welchen bei denen es nicht funktioniert.

Hier der Code mit Zeitserver der auch funktioniert:

Code:

Option Compare Database
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function WSAStartup Lib "ws2_32.dll" ( _
ByValwVersionRequired As Integer, _
ByRef lpWSAData As WSADATA) As Long
Private Declare Function socket Lib "ws2_32.dll" ( _
ByVal af As Long, _
ByVal lType As Long, _
ByVal protocol As Long) As Long
Private Declare Function connect Lib "ws2_32.dll" ( _
ByVal s As Long, _
ByRef Name As SOCKADDR, _
ByVal namelen As Long) As Long
Private Declare Function htons Lib "ws2_32.dll" ( _
ByVal hostshort As Integer) As Integer
Private Declare Function inet_addr Lib "ws2_32.dll" ( _
ByVal cp As String) As Long
Private Declare Function recv Lib "ws2_32.dll" ( _
ByVal s As Long, _
ByVal buf As String, _
ByVal lLen As Long, _
ByVal flags As Long) As Long
Private Declare Function closesocket Lib "ws2_32.dll" ( _
ByVal s As Long) As Long
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
Private Declare Function GetTimeZoneInformation Lib "kernel32.dll" ( _
ByRef lpTZI As TIME_ZONE_INFORMATION) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Private Const WS_VERSION_REQD As Long = &H101&
Private Const WSADESCRIPTION_LEN As Long = 256
Private Const WSASYS_STATUS_LEN As Long = 128

Private Const AF_INET As Long = 2
Private Const SOCK_STREAM As Long = 1
Private Const IPPROTO_TCP As Long = 6

Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2

Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSADESCRIPTION_LEN
szSystemStatus As String * WSASYS_STATUS_LEN
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Private Type SOCKADDR
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName(31) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(31) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type

Public Function InternetTime() As Date

'Eine Liste der Deutschen Zeitserver findes du hier:
'NTP-Server

Const SERVER_IP As String = "134.130.4.17" 'RWTH Aachen #1
'Const SERVER_IP As String = "134.130.5.17" 'RWTH Aachen #2

Dim udtData As WSADATA, udtAdresse As SOCKADDR
Dim udtTimeZone As TIME_ZONE_INFORMATION
Dim strTime As String, strRecvData As String * 5
Dim dblTimeStamp As Double
Dim dtmTime As Date
Dim lngStartupReturn As Long, lngSocketReturn As Long
Dim lngConnectReturn As Long, lngReceiveReturn As Long
Dim lngCloseReturn As Long, lngTZIReturn As Long
Dim lngGTCReturn As Long

lngStartupReturn = WSAStartup(WS_VERSION_REQD, udtData)
If lngStartupReturn 0 Then Exit Function

lngSocketReturn = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
If lngSocketReturn > 10000 And lngSocketReturn < 11005 Then Exit Function

udtAdresse.sin_family = AF_INET
udtAdresse.sin_addr = inet_addr(SERVER_IP)
udtAdresse.sin_port = htons(37)
lngConnectReturn = connect(lngSocketReturn, udtAdresse, Len(udtAdresse))
If lngConnectReturn 0 Then Exit Function

lngGTCReturn = GetTickCount()
lngReceiveReturn = recv(lngSocketReturn, strRecvData, Len(strRecvData), 0)
strTime = Left$(strRecvData, lngReceiveReturn)
If lngReceiveReturn 4 Then Exit Function

lngCloseReturn = closesocket(lngSocketReturn)
If lngCloseReturn 0 Then Exit Function

Call WSACleanup

dblTimeStamp = Asc(Mid(strTime, 1, 1)) * 256 ^ 3 + _
Asc(Mid(strTime, 2, 1)) * 256 ^ 2 + _
Asc(Mid(strTime, 3, 1)) * 256 ^ 1 + _
Asc(Mid(strTime, 4, 1)) - 3155673600#

lngTZIReturn = GetTimeZoneInformation(udtTimeZone)

If lngTZIReturn = TIME_ZONE_ID_DAYLIGHT Then
dblTimeStamp = dblTimeStamp - (udtTimeZone.Bias * 60 + _
udtTimeZone.DaylightBias * 60)
Else
dblTimeStamp = dblTimeStamp - udtTimeZone.Bias * 60
End If

lngGTCReturn = Round((GetTickCount - lngGTCReturn) / 1000, 0)
dblTimeStamp = dblTimeStamp + lngGTCReturn
dtmTime = DateAdd("s", dblTimeStamp, DateSerial(2000, 1, 1))

InternetTime = dtmTime

End Function

Public Sub SetDateTime()

Dim dtmNow As Date

dtmNow = InternetTime

If dtmNow 0 Then

' Time = TimeValue(dtmNow) 'Systemuhrzeit synchronisieren
' Date = DateValue(dtmNow) 'Systenkalender synchronisieren

Call MsgBox(Format(dtmNow, "dd.mm.yyyy hh:nn:ss"), vbInformation, "Information")

Else
Call MsgBox("Fehler beim Lesen der Internetzeit.", vbCritical, "Programmabbruch")
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Eine Liste an Zeitservern findet Ihr hier:
NTP-Serverliste
....aber Vorsicht, offenbar funktionieren hier sehr viele entweder mit dem Script nicht oder die Server sind mittlerweile offline (ein Datum wie alt die Liste ist steht leider nicht dabei :-(

Ich hoffe das der nächste der diese Funktion benötigt durch meine Info nicht in die selbe Falle tapt wie ich ;-)

Gruß
Stefan

PS: trotzdem Danke für eure Hilfe, ohne eure Hilfe wäre ich nicht wirklich so schnell darauf gekommen (oder gar nicht) das da 20 (getestete) Server nicht wollen

markusxy · 3. August 2020

Aber immerhin der Code funktioniert, das ist schon mal super.
Vielleicht sollte man die Funktion so erweitern, dass die Anwendung erfährt, wenn der Server nicht erreichbar ist. Zusätzlich wäre ein Protokoll denkbar.

LG Markus

edv-master · 3. August 2020

Hallo Markus,

ja, das wäre noch eine geile Idee ;-)

ich habe jetzt vorübergehend den Code so abgeändert:

Code:

ption Compare Database
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function WSAStartup Lib "ws2_32.dll" ( _
ByValwVersionRequired As Integer, _
ByRef lpWSAData As WSADATA) As Long
Private Declare Function socket Lib "ws2_32.dll" ( _
ByVal af As Long, _
ByVal lType As Long, _
ByVal protocol As Long) As Long
Private Declare Function connect Lib "ws2_32.dll" ( _
ByVal s As Long, _
ByRef Name As SOCKADDR, _
ByVal namelen As Long) As Long
Private Declare Function htons Lib "ws2_32.dll" ( _
ByVal hostshort As Integer) As Integer
Private Declare Function inet_addr Lib "ws2_32.dll" ( _
ByVal cp As String) As Long
Private Declare Function recv Lib "ws2_32.dll" ( _
ByVal s As Long, _
ByVal buf As String, _
ByVal lLen As Long, _
ByVal flags As Long) As Long
Private Declare Function closesocket Lib "ws2_32.dll" ( _
ByVal s As Long) As Long
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
Private Declare Function GetTimeZoneInformation Lib "kernel32.dll" ( _
ByRef lpTZI As TIME_ZONE_INFORMATION) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

Private Const WS_VERSION_REQD As Long = &H101&
Private Const WSADESCRIPTION_LEN As Long = 256
Private Const WSASYS_STATUS_LEN As Long = 128

Private Const AF_INET As Long = 2
Private Const SOCK_STREAM As Long = 1
Private Const IPPROTO_TCP As Long = 6

Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2

Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSADESCRIPTION_LEN
szSystemStatus As String * WSASYS_STATUS_LEN
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Private Type SOCKADDR
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName(31) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(31) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type

Public Function InternetTime() As Date

'Eine Liste der Zeitserver findes du hier:
'NTP-Server Deutsche Zeitserver
'NIST Internet Time Service US/Internationale Zeitserver

Const SERVER_IP As String = "134.130.4.17" 'RWTH Aachen #1
'Const SERVER_IP As String = "134.130.4.17" 'RWTH Aachen #1
'Const SERVER_IP As String = "134.130.5.17" 'RWTH Aachen #2
'Const SERVER_IP As String = "128.138.140.44" 'University of Colorado, Boulder #1
'Const SERVER_IP As String = "128.138.141.172" ''University of Colorado, Boulder #2

Dim udtData As WSADATA, udtAdresse As SOCKADDR
Dim udtTimeZone As TIME_ZONE_INFORMATION
Dim strTime As String, strRecvData As String * 5
Dim dblTimeStamp As Double
Dim dtmTime As Date
Dim lngStartupReturn As Long, lngSocketReturn As Long
Dim lngConnectReturn As Long, lngReceiveReturn As Long
Dim lngCloseReturn As Long, lngTZIReturn As Long
Dim lngGTCReturn As Long

lngStartupReturn = WSAStartup(WS_VERSION_REQD, udtData)
If lngStartupReturn 0 Then GoTo FunctionExit

lngSocketReturn = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
If lngSocketReturn > 10000 And lngSocketReturn < 11005 Then GoTo FunctionExit

udtAdresse.sin_family = AF_INET
udtAdresse.sin_addr = inet_addr(SERVER_IP)
udtAdresse.sin_port = htons(37)
lngConnectReturn = connect(lngSocketReturn, udtAdresse, Len(udtAdresse))
If lngConnectReturn 0 Then GoTo FunctionExit

lngGTCReturn = GetTickCount()
lngReceiveReturn = recv(lngSocketReturn, strRecvData, Len(strRecvData), 0)
strTime = Left$(strRecvData, lngReceiveReturn)
If lngReceiveReturn 4 Then GoTo FunctionExit

lngCloseReturn = closesocket(lngSocketReturn)
If lngCloseReturn 0 Then GoTo FunctionExit

Call WSACleanup

dblTimeStamp = Asc(Mid(strTime, 1, 1)) * 256 ^ 3 + _
Asc(Mid(strTime, 2, 1)) * 256 ^ 2 + _
Asc(Mid(strTime, 3, 1)) * 256 ^ 1 + _
Asc(Mid(strTime, 4, 1)) - 3155673600#

lngTZIReturn = GetTimeZoneInformation(udtTimeZone)

If lngTZIReturn = TIME_ZONE_ID_DAYLIGHT Then
dblTimeStamp = dblTimeStamp - (udtTimeZone.Bias * 60 + _
udtTimeZone.DaylightBias * 60)
Else
dblTimeStamp = dblTimeStamp - udtTimeZone.Bias * 60
End If

lngGTCReturn = Round((GetTickCount - lngGTCReturn) / 1000, 0)
dblTimeStamp = dblTimeStamp + lngGTCReturn
dtmTime = DateAdd("s", dblTimeStamp, DateSerial(2000, 1, 1))

'InternetTime = dtmTime

FunctionExit:
If dtmTime 0 Then
InternetTime = dtmTime
Else
InternetTime = Now()
Call MeldungAnzeigen("Da scheinbar der Zeitserver 'offline' ist wird die 'Systemzeit' dieser Arbeitsstation verwendet!", 3, "Zeitserver offline?", vbInformation)
End If
Exit Function

End Function

Public Sub MeldungAnzeigen(Meldung As String, _
Optional ByVal TimerIntervall_sec As Long, _
Optional ByVal Titel As String, _
Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly)

'Late Binding: Kein Verweis auf "Microsoft Scripting Runtime" und
'kein Verweis auf "Windows Script Host Object Model" notwendig

'Quelle: DBWiki - VBA Tipp: Eine Meldung zeitgesteuert anzeigen – DBWiki

Const ForWriting As Long = 2

Dim FSO As Object 'IWshRuntimeLibrary.FileSystemObject
Dim WSH As Object 'IWshRuntimeLibrary.WshShell (Windows Scripting Host)
Dim Datei As Object 'TextStream
Dim tempDatei As String

Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")

'Der Name der vbs-Datei ist egal, nur die Dateiendung .vbs ist wichtig
tempDatei = "MeldungAnzeigen.vbs"
Set Datei = FSO.OpenTextFile(tempDatei, ForWriting, True)

With Datei
.WriteLine "Dim ObjShell"
.WriteLine "Set ObjShell = CreateObject(""WScript.Shell"")"
.WriteLine "ObjShell.Popup """ & Meldung & """," & _
TimerIntervall_sec & ",""" & _
Titel & """, " & _
Buttons
.WriteLine "Set ObjShell = Nothing"
.Close
End With

'vbs-Datei ausführen
WSH.Run tempDatei, , True

'temporäre Datei löschen
FSO.DeleteFile tempDatei, True

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

....so habe ich immer eine Uhrzeit zum arbeiten (und der User bekommt für 3 Sek. die Meldung das er mit der "Offline-Zeit" arbeitet), egal ob online oder offline ;-)

Gruß
Stefan

Office: (Office 2016) Aktuelle Zeit vom Zeitserver im Internet

Aktuelle Zeit vom Zeitserver im Internet

Aktuelle Zeit vom Zeitserver im Internet

Aktuelle Zeit vom Zeitserver im Internet

Aktuelle Zeit vom Zeitserver im Internet

Aktuelle Zeit vom Zeitserver im Internet - Similar Threads - Aktuelle Zeit Zeitserver

Nur aktuelles Jahr in Abfrage auslesen

Aktuelles Datum und aktuelle Uhrzeit (System) einfügen wenn Änderungen in einer Zelle stattfinden

Bedingte Formatierung aktuelles Jahr Zelle Färben

Alle Spalten rechts von der aktuellen Zelle addieren

Anhand von KW und Zeit aktuelle Schicht ermitteln

Wie Kalender ausdrucken - OHNE aktuelle Datum-/Zeit-Angabe unten rechts

Aktuelles Datum und momentane Zeit einfügen