جلب التاريخ و الوقت الحاليين من الأنترنت

[صالح حمادي]

السلام عليكم

هذه طريقة للحصول على الوقت و التاريخ الحاليين للأنترنت حسب توقيت غرينتش

نستخدم هذه الوحدة النمطية:

Function GetUCTTimeDate() As String
    Dim UTCDateTime As String
    Dim arrDT() As String
    Dim http As Object
    Dim UTCDate As String
    Dim UTCTime As String

    Const NetTime As String = "https://www.time.gov/"

    On Error Resume Next
    Set http = CreateObject("Microsoft.XMLHTTP")
    On Error GoTo 0

    http.Open "GET", NetTime & Now(), False, "", ""
    http.send

    UTCDateTime = http.getResponseHeader("Date")
    UTCDate = Mid(UTCDateTime, InStr(UTCDateTime, ",") + 2)
    UTCDate = Left(UTCDate, InStrRev(UTCDate, " ") - 1)
    UTCTime = Mid(UTCDate, InStrRev(UTCDate, " ") + 1)
    UTCDate = Left(UTCDate, InStrRev(UTCDate, " ") - 1)
    GetUCTTimeDate = UTCDate & " " & UTCTime
End Function

و نقوم باستدعاء الناتج هكذا

MsgBox GetUCTTimeDate()

 

[محمد أبوعبدالله]

رائع استاذنا الفاضل

دمتم بكل خير

تحياتي

[mrbakr]

ممتاز