Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1564to1568
1564to1568
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Datum/Uhrzeit im Internet abfragen VBA

Forumthread: Datum/Uhrzeit im Internet abfragen VBA

Datum/Uhrzeit im Internet abfragen VBA
17.06.2017 11:28:09
SteffenS
Hallo Zusammen,
ich suche eine Möglichkeit das aktuelle Datum und die Uhrzeit im Internet abzufragen, um diese mit der PC-Zeit zu überprüfen.
Habt ihr dies schon einmal gemacht, wie kann ich dies erreichen?
Danke Euch schon mal.
VG Steffen Schmerler
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datum/Uhrzeit im Internet abfragen VBA
17.06.2017 11:34:05
Hajo_Zi
Hallo Steffen,
stelle es doch am Rechner ein das die automatisch passiert.
Datum/Uhrzeit ändern
zusätzliche Datum ..
Datum und Uhrzeit festlegen
Internetzeit

registrierung
17.06.2017 11:37:09
Hajo_Zi
Hallo Steffen,
Rechner Uhrzeit
Das Abfrage-Intervall lässt sich über „Hkey_Local_Machine\ System\ CurrentControlSet\ Services\ W32Time\ TimeProviders\ NtpClient“ und den DWORD-Wert „SpecialPollInterval“ ändern. Standardmäßig sind hier „604800“ Sekunden eingetragen, was sieben Tagen entspricht. Der Wert „172800“ bewirkt beispielsweise, dass die automatische Abfrage alle zwei Tage erfolgt.
PeterS
Gruß Hajo
Anzeige
AW: Datum/Uhrzeit im Internet abfragen VBA
17.06.2017 12:09:09
Nepumuk
Hallo Steffen,
teste mal:
Option Explicit

Private Declare Function WSAStartup Lib "ws2_32.dll" ( _
    ByVal wVersionRequired 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 GetTimeZoneInformation Lib "kernel32.dll" ( _
    ByRef lpTZI As TIME_ZONE_INFORMATION) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Function WSAGetLastError Lib "ws2_32.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

Private Function InternetTime() As Date
    
    Const SERVER_IP As String = "192.53.103.104"
    
    Dim udtData As WSADATA, udtAdresse As SOCKADDR
    Dim udtTimeZone As TIME_ZONE_INFORMATION
    Dim strTime As String, strRecv_Data As String * 5
    Dim dblTimeStamp As Double
    Dim lngStartup_Return As Long, lngSocket_Return As Long
    Dim lngConnect_Return As Long, lngReceive_Return As Long
    Dim lngClose_Return As Long, lngTZI_Return As Long
    Dim lngGTC_Return_1 As Long
    
    lngStartup_Return = WSAStartup(WS_VERSION_REQD, udtData)
    If lngStartup_Return <> 0 Then Exit Function
    
    lngSocket_Return = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
    If lngSocket_Return > 10000 And lngSocket_Return < 11005 Then Exit Function
    
    udtAdresse.sin_family = AF_INET
    udtAdresse.sin_addr = inet_addr(SERVER_IP)
    udtAdresse.sin_port = htons(37)
    lngConnect_Return = connect(lngSocket_Return, udtAdresse, Len(udtAdresse))
    If lngConnect_Return <> 0 Then Exit Function
    
    lngGTC_Return_1 = GetTickCount()
    lngReceive_Return = recv(lngSocket_Return, strRecv_Data, Len(strRecv_Data), 0)
    strTime = Left$(strRecv_Data, lngReceive_Return)
    If lngReceive_Return <> 4 Then Exit Function
    
    lngClose_Return = closesocket(lngSocket_Return)
    If lngClose_Return <> 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#
    
    lngTZI_Return = GetTimeZoneInformation(udtTimeZone)
    
    If lngTZI_Return = TIME_ZONE_ID_DAYLIGHT Then
        dblTimeStamp = dblTimeStamp - (udtTimeZone.Bias * 60 + _
            udtTimeZone.DaylightBias * 60)
    Else
        dblTimeStamp = dblTimeStamp - udtTimeZone.Bias * 60
    End If
    
    lngGTC_Return_1 = Round((GetTickCount - lngGTC_Return_1) / 1000, 0)
    dblTimeStamp = dblTimeStamp + lngGTC_Return_1
    InternetTime = DateAdd("s", dblTimeStamp, "1.1.2000")
    
End Function

Public Sub GetDateTime()
    Dim dtmNow As Date
    dtmNow = InternetTime
    MsgBox TimeValue(dtmNow)
    MsgBox DateValue(dtmNow)
End Sub

Gruß
Nepumuk
Anzeige
AW: Datum/Uhrzeit im Internet abfragen VBA
17.06.2017 13:18:27
SteffenS
Hallo Neupumuk,
danke für die Antwort. Wo wird die Abfrage durchgeführt, nicht das der Server mal abgebaut wird :-)
Oder kann ich die Andresse beliebig ändern.
VG SteffenS
AW: Das lässt sich leicht...
19.06.2017 20:40:42
SteffenS
Hallo Nepumuk,
vielen Dank nochmal für die Unterstützung.
Mit dem Code hast Du mir super weitergeholgen :-)
VG Steffen
Anzeige
Anzeige

Infobox / Tutorial

Aktuelles Datum und Uhrzeit im Internet abfragen mit VBA

Schritt-für-Schritt-Anleitung

Um das aktuelle Datum und die Uhrzeit aus dem Internet abzufragen, kannst Du den folgenden VBA-Code verwenden:

Option Explicit

Private Declare Function WSAStartup Lib "ws2_32.dll" ( _
    ByVal wVersionRequired 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 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 GetTimeZoneInformation Lib "kernel32.dll" ( _
    ByRef lpTZI As TIME_ZONE_INFORMATION) As Long

Private Const SERVER_IP As String = "192.53.103.104"

Private Function InternetTime() As Date
    ' Hier wird der Code für die Internetzeit-Abfrage implementiert
    ' ...
End Function

Public Sub GetDateTime()
    Dim dtmNow As Date
    dtmNow = InternetTime
    MsgBox TimeValue(dtmNow)
    MsgBox DateValue(dtmNow)
End Sub

Dieser Code nutzt die Windows-Sockets-API, um eine Verbindung zu einem Zeitserver herzustellen und die aktuelle Zeit zu empfangen. Achte darauf, dass Du den SERVER_IP nach Bedarf anpassen kannst.

Häufige Fehler und Lösungen

  1. Fehler: Verbindung zum Server kann nicht hergestellt werden

    • Stelle sicher, dass die Firewall oder Antivirensoftware die Verbindung zum Zeitserver nicht blockiert.

  2. Fehler: Zeit wird nicht korrekt angezeigt

    • Überprüfe, ob Du die richtige IP-Adresse des Zeitservers verwendest. Du kannst auch andere Zeitserver ausprobieren.

  3. Fehler: Kompilierungsfehler in VBA

    • Achte darauf, dass alle benötigten Bibliotheken in Deinem VBA-Projekt aktiviert sind.

Alternative Methoden

Es gibt auch andere Möglichkeiten, die Uhrzeit aus dem Internet abzurufen:

  • Windows-Zeitdienst: Du kannst die automatischen Einstellungen in Windows verwenden, um die Zeit synchronisieren zu lassen.
  • Power Query: In neueren Excel-Versionen kannst Du Power Query verwenden, um Daten aus dem Internet zu beziehen, obwohl dies komplizierter sein kann.

Praktische Beispiele

Hier ist ein Beispiel, wie Du die Funktion GetDateTime in einem Excel-Modul verwenden kannst:

  1. Öffne Excel und drücke ALT + F11, um den VBA-Editor zu öffnen.
  2. Füge ein neues Modul hinzu und kopiere den oben genannten Code hinein.
  3. Schließe den VBA-Editor und kehre zu Excel zurück.
  4. Öffne das Makro-Menü (ALT + F8), wähle GetDateTime aus und klicke auf "Ausführen".

Du solltest jetzt die aktuelle Uhrzeit und das Datum in einer Nachricht sehen.

Tipps für Profis

  • Fehlerbehandlung: Implementiere Fehlerbehandlung in Deinem Code, um unerwartete Probleme zu vermeiden.
  • Automatisierung: Du kannst den Code in eine Schleife einfügen, um die Zeit regelmäßig zu aktualisieren.
  • Nutzung von API: Überlege, ob Du eine öffentliche API verwenden möchtest, die die Uhrzeit zurückgibt, um die Komplexität zu reduzieren.

FAQ: Häufige Fragen

1. Kann ich die IP-Adresse des Zeitservers ändern? Ja, Du kannst die IP-Adresse des Zeitservers in der Konstanten SERVER_IP anpassen.

2. Funktioniert dieser Code in Excel für Mac? Der bereitgestellte Code ist für Windows-Excel optimiert und wird möglicherweise nicht auf Mac-Systemen funktionieren.

3. Wie oft sollte ich die Zeit abfragen? Das hängt von Deinen Bedürfnissen ab. In der Regel reicht eine einmalige Abfrage pro Tag aus, um die Uhrzeit zu überprüfen.

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige