从 Internet 服务器上取件时间 VBA Excel
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16190812/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Pickup Time From Internet Servers VBA Excel
提问by MeenakshiSundharam
Is there a VBA code that can be run in Excel 2007 which retrieves the date and time from a very well known Internet Server? I need this to call a macro based on the date and time so retrieved. The code should not paste the value anywhere, but have the date and time stored in a variable.
是否有可以在 Excel 2007 中运行的 VBA 代码，它可以从非常著名的 Internet 服务器中检索日期和时间？我需要它来根据检索到的日期和时间调用宏。代码不应将值粘贴到任何地方，而应将日期和时间存储在变量中。
For example the url http://tycho.usno.navy.mil/cgi-bin/timer.pltakes us to a webpage that has the current time only for a few time zones in the US.
例如，网址http://tycho.usno.navy.mil/cgi-bin/timer.pl将我们带到一个网页，该网页只有美国几个时区的当前时间。
回答by Our Man in Bananas
you could try something like the below which I have in my Personal.xls workbook (found it a few months back for something):
您可以尝试以下类似我在 Personal.xls 工作簿中的内容（几个月前找到了它）：
Sub GetiNetTime()
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'
'
' The GetiNetTime macro is written by Karthikeyan T.
'
' Please Note: Original code adjusted here for setting Indian Standard Time,
' India Standard Time (IST) = GMT+5:30
' Time adjusted for BST by setting the 'Hr' variable = 1 to get GMT+1
'
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'
Dim ws
Dim http
Dim GMT_Time, NewNow, NewDate, NewTime, Hr, Mn ', Sc
'Below line wont work since clock providers changed the URL.
'Const GMTTime As String = "http://wwp.greenwichmeantime.com/time/scripts/clock-8/runner.php"
'Updated URL to fetch internet time ***
'Macro updated Date & Time: 27-Oct-12 1:07 PM
Const GMTTime As String = "http://wwp.greenwichmeantime.com/time/scripts/clock-8/runner.php?tz=gmt"
On Error Resume Next
Set http = CreateObject("Microsoft.XMLHTTP")
http.Open "GET", GMTTime & Now(), False, "", ""
http.Send
GMT_Time = http.getResponseHeader("Date")
GMT_Time = Mid$(GMT_Time, 6, Len(GMT_Time) - 9)
'Set Indian Standard Time from Greenwich Mean Time.
'India Standard Time (IST) = GMT+5:30
Hr = 1 'Hours. =1 for BST, 2 for Europe Time, 11 for Oz?
Mn = 0 'Minutes.
'Sc = 0 'Seconds.
NewNow = DateAdd("h", Hr, GMT_Time) 'Adding 5 Hours to GMT.
NewNow = DateAdd("n", Mn, NewNow) 'Adding 30 Minutes to GMT.
'NewNow = DateAdd("s", Sc, NewNow) 'Adding 0 Seconds to GMT.
MsgBox "Current Date & Time is: GMT " & NewNow, vbOKOnly, "GetiNetTime"
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'
'
' If you want to insert the new date & time in excel worksheet just unquote
' the following lines,
'
' Sheets("Sheet1").Select
' Range("A1").Select
' ActiveCell.Value = NewNow
'
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'
'Insert current date & time in cell on selected worksheet.
'Sheets("Sheet1").Select 'Select worksheet as you like
'Range("A1").Select 'Change the destination as you like
'ActiveCell.Value = NewNow
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'
'
' If you want to change the system time just unquote the following lines,
'
' Set ws = CreateObject("WScript.Shell")
' NewDate = DateValue(NewNow)
' NewTime = Format(TimeValue(NewNow), "hh:mm:ss")
' ws.Run "%comspec% /c time " & NewTime, 0
' ws.Run "%comspec% /c date " & NewDate, 0
' Set ws = Nothing
'
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'
'Set ws = CreateObject("WScript.Shell")
'Split out date.
'NewDate = DateValue(NewNow)
'Split out time.
'NewTime = Format(TimeValue(NewNow), "hh:mm:ss")
'Run DOS Time command in hidden window.
'ws.Run "%comspec% /c time " & NewTime, 0
'Run DOS Date command in hidden window.
'ws.Run "%comspec% /c date " & NewDate, 0
Cleanup:
'Set ws = Nothing
Set http = Nothing
End Sub
