Date and time from a server

[BoFenger]

Hi
Using VBA in excel
Is it possible to get the time and date from a server, fx. yahoo.com


\Bo

 

[ETID]

'You can get your local server time.

'In the last proceedure posted here .... enter your logon 'or network servername.

'----------------------------------------------------

Option Compare Database
Option Explicit
'
'Public getRemoteTOD As String

'
Private Declare Function NetRemoteTOD Lib "Netapi32.dll" ( _
tServer As Any, pBuffer As Long) As Long
'
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(32) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(32) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
'
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
'
Private Declare Function NetApiBufferFree Lib "Netapi32.dll" (ByVal lpBuffer As Long) As Long
'
Private Type TIME_OF_DAY_INFO
tod_elapsedt As Long
tod_msecs As Long
tod_hours As Long
tod_mins As Long
tod_secs As Long
tod_hunds As Long
tod_timezone As Long
tod_tinterval As Long
tod_day As Long
tod_month As Long
tod_year As Long
tod_weekday As Long
End Type
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'
'
'Public Function getRemoteTOD(ByVal strServer As String) As Date
Sub getRemoteTOD(ByVal strServer As String) 'As Date
'
Dim result As Date
Dim lRet As Long
Dim tod As TIME_OF_DAY_INFO
Dim lpbuff As Long
Dim tServer() As Byte
'
tServer = strServer & vbNullChar
lRet = NetRemoteTOD(tServer(0), lpbuff)
'
If lRet = 0 Then
CopyMemory tod, ByVal lpbuff, Len(tod)
NetApiBufferFree lpbuff
'result = DateSerial(tod.tod_year, tod.tod_month, tod.tod_day) + _
'TimeSerial(tod.tod_hours, tod.tod_mins - tod.tod_timezone, tod.tod_secs)
result = DateSerial(tod.tod_year, tod.tod_month, tod.tod_day)
getRemoteTOD = result
Else
Err.Raise Number:=vbObjectError + 1001, _
Description:="cannot get remote TOD"
End If
'
MsgBox (result)
End Sub




Private Sub GetRemoteTime()
Dim d As Date
'
d = getRemoteTOD("\\your_server_name&quot
MsgBox d
End Sub