获取网络时间

clyfd

haofeng4645 发表于 2018-4-17 09:36
小兄弟，人家要的是网络时间，不是本机的系统时间，本机时间会出错的。

电脑联网后系统不是制动更新时间吗？
windows 系统增加了一项自动与Internet时间服务器同步的功能。对于联了网的用户可以开启此功能，这样，计算机系统时钟每隔一周就会与Internet时间服务器进行一次同步，从而保证系统时间的准确。
我合计系统时间就是网络时间呢
还有，我真不是小兄弟，应该是老兄弟了

何必爱学习

linyh1742595842 发表于 2018-4-16 17:26
Private Function getWebDatetime() As String
    Dim XmlHttp As Object
    Set XmlHttp = CreateObje ...

大师，我用你这个，有时候报错，可怎么解决啊？ 出现 运行时错误 -2147024891（80070005）

szgoots

6楼的方法不错。

shadows727

不会用，脑壳疼。

zhigy0882

kldxlb 发表于 2018-4-16 19:15
Function getCurrentTime()
    With CreateObject("Microsoft.XMLHTTP")
        .Open "HEAD", "https: ...

这个可以用，5楼的好像不行。
谢谢！

苏保丁

Private Sub Workbook_Open()宏设置为启用所有宏，为 什么不能自动执行，显示FORM1？
将宏安全设置成禁用所有宏并发通知，打开EXCEL时，有提示，选择执行时，可以显示FORM1
Dim MyMac, mc, Password, Pword

Set MyMac = GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")
    For Each MyMacAddress In MyMac
   If MyMacAddress.IPEnabled = True Then
     mc = MyMacAddress.MacAddress
    Exit For
    End If
    Next
    If getCurrentTime > #3/10/2020# Then
MsgBox "租赁已到期，请续费。"
    Pword = InputBox("请输入密码")
    Password = "13647713624"
    If Pword <> Password Then
        MsgBox "对不起，没有访问权限！"
       Application.OnTime Now + TimeValue("00:00:30"), "abc"
       Else
       MsgBox "密码正确，但系统将在一分钟后关闭"
       Application.OnTime Now + TimeValue("00:03:00"), "abc"
        End
    End If
ElseIf mc = "E0:D5:5E:51:E7:8A" Or mc = "04:D9:F5:22:6F:25" Or mc = "0C:9D:92:CA:EE:4B" Or mc = "F0:79:59:72:01:C2" Or mc = "00:87:36:30:4A:DA" _
Or mc = "00:87:36:2D:E6:1F" Or mc = "08:62:66:2F:2D:0E" Or mc = "00:E0:70:0F:E8:30" Or mc = "00:E0:4C:39:30:CB" Or mc = "00:F1:F3:0B:1D:53" _
Or mc = "E0:D5:5E:51:E8:B6" Or mc = "00:30:18:AA:69:BC" Or mc = "00:E0:70:0F:E8:25" Or mc = "40:8D:5C:F4:E7:15" Or mc = "00:E0:4C:06:35:BD" _
Or mc = "00:E0:4C:8A:EB:A1" Or mc = "2C:4D:54:67:8C:75" Or mc = "00:E0:70:0F:FB:69" Or mc = "1C:1B:0D:DF:F2:3D" Or mc = "E0:D5:5E:51:E7:70" _
Or mc = "FC:AA:14:39:9A:97" Or mc = "F4:B5:20:12:35:D1" Or mc = "54:14:F3:F4:F3:0D" Or mc = "E0:D5:5E:51:E8:BB" Then

    Else
    MsgBox "序列号不正确，请联系管理员。"
    Pword = InputBox("请输入密码")
   Password = "13647713624"
    If Pword <> Password Then
        MsgBox "对不起，没有访问权限！"
       Application.OnTime Now + TimeValue("00:00:02"), "abc"
       Else
       MsgBox "密码正确，但系统将在一分钟后关闭"
       Application.OnTime Now + TimeValue("00:03:00"), "abc"
        End
    End If
    End If
End Sub
Function getCurrentTime()
    With CreateObject("Microsoft.XMLHTTP")
        .Open "HEAD", "https://www.baidu.com/", False
        .send
        t = .getResponseHeader("Date")
    End With
    getCurrentTime = CDate(1 / 3 + CDbl(CDate(Mid$(t, 5, 21))))
End Function





Sub add()
Dim i As Long
If getCurrentTime < #3/10/2020# Then
For i = 2 To Sheets("工地汇总").Range("a1").CurrentRegion.Rows.Count
  Sheets.add Sheets("demo")
  ActiveSheet.Name = Sheets("工地汇总").Range("a" & i)
Next
End If
End Sub

Sub mac()
Dim MyMac
    Set MyMac = GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")
    For Each MyMacAddress In MyMac
      If MyMacAddress.IPEnabled = True Then
      MsgBox "本机网卡MAC地址是：" & MyMacAddress.MacAddress
    Exit For
    End If
    Next
End Sub

Sub 无套环()
Dim m As String, i As Integer
If getCurrentTime < #3/10/2020# Then
For i = 2 To Sheets("工地汇总").Range("a1").CurrentRegion.Rows.Count
  Sheets.add Sheets("demo1")