是否有可以在 Excel 2007 中运行的 VBA 代码，用于从非常知名的 Internet 服务器检索日期和时间？我需要它来根据检索到的日期和时间调用宏。...
是否有可以在 Excel 2007 中运行的 VBA 代码，用于从非常知名的 Internet 服务器检索日期和时间？我需要根据检索到的日期和时间调用宏。代码不应将值粘贴到任何地方，而应将日期和时间存储在变量中。
例如，网址 http://tycho.usno.navy.mil/cgi-bin/timer.pl 将带我们进入一个仅显示美国几个时区当前时间的网页。
您可以尝试类似下面的操作，我在 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