用VBA获取指定计算机上的系统时间

Question

最好不用COMMAND方式，因为这样会有黑色窗口闪过，另指定计算机上也不一定有SQL，我是ACCESS的VBA，因为获取本地时间时怕用户是改完时间后获取到的，所以不准，现要求使用这个软件的用户都到企业内部网的某台计算机上获取时间，请高手助！

Answer 1

Option Explicit
  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
          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)
                  getRemoteTOD = result
          Else
                  Err.Raise Number:=vbObjectError + 1001, _
                  Description:="cannot   get   remote   TOD"
          End If
  End Function
     Private Sub Command1_Click()
          Dim d     As Date
          d = getRemoteTOD("\\192.168.0.9")
          MsgBox d
  End Sub

Answer 2

有个折中的法子，不知道行不行。在远程主机上建立ftp服，并用软件将时间写到ftp服的文件里。本地主机用vba访问远程的ftp服，获取时间。具体的vba远程访问ftp方法可以去搜索下

Answer 3

精通matlab图像处理 张强 王正林（适合初学者） 数字图像处理 冈萨雷斯（全部是数学公式推导，适合深入研究） 数字图像处理matlab 冈萨雷斯

Answer 4

Option Explicit
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
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)
getRemoteTOD = result
Else
Err.Raise Number:=vbObjectError + 1001, _
Description:="cannot get remote TOD"
End If
End Function
Private Sub Command1_Click()
Dim d As Date
d = getRemoteTOD("\\192.168.0.9")
MsgBox d
End Sub
另外.net和C的用别的方法都可以获得，你将它们写成dll文件，用vba调用也可以本回答被提问者采纳