Hi John
The following function will return the date and time from a given remote
computer. Just copy it and paste it into a new module, then call it like
this:
Dim dt as Date
dt = GetRemoteTime("MyServer")
If dt = 0 Then
' error has occurred
Else
...
End If
--
Good Luck
Graham Mandeno [Access MVP]
Auckland, New Zealand
============== start code ===============
Option Explicit
Private Const NERR_SUCCESS = 0&
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 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 Declare Function NetRemoteTOD Lib "netapi32" ( _
UncServerName As Byte, _
BufferPtr As Long _
) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" ( _
ByVal lpBuffer As Long _
) As Long
Private Declare Sub CopyMem Lib "kernel32" _
Alias "RtlMoveMemory" ( _
pTo As Any, _
pFrom As Any, _
ByVal lSize As Long)
Public Function GetRemoteTime(sServer As String) As Date
Dim tod As TIME_OF_DAY_INFO
Dim bServer() As Byte
Dim bufptr As Long
Dim lRet As Long
'A null string passed as sServer retrieves the date
'for the local machine - no slashes are added.
If Len(sServer) <> 0 Then
' Ensure server name has leading double slashes
If Left$(sServer, 2) <> "\\" Then
bServer = "\\" & sServer & vbNullChar
Else
bServer = sServer & vbNullChar
End If
Else
bServer = sServer & vbNullChar
End If
lRet = NetRemoteTOD(bServer(0), bufptr)
If lRet = NERR_SUCCESS Then
'copy the buffer into TIME_OF_DAY_INFO structure
CopyMem tod, ByVal bufptr, LenB(tod)
With tod
GetRemoteTime = DateAdd("n", -.tod_timezone, _
DateSerial(.tod_year, .tod_month, .tod_day) _
+ TimeSerial(.tod_hours, .tod_mins, .tod_secs))
End With
Else
' error occurred - return 0 (30 Dec 1899)
GetRemoteTime = 0
End If
Call NetApiBufferFree(bufptr)
End Function
=========== end code ===============
