Internet服务器VBA Excel的接送时间 [英] Pickup Time From Internet Servers VBA Excel

问题描述

是否存在可以在Excel 2007中运行的VBA代码，该代码可以从非常著名的Internet Server检索日期和时间?我需要它根据检索到的日期和时间来调用宏.该代码不应将值粘贴到任何地方，而应将日期和时间存储在变量中.

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.

例如网址 http://tycho.usno.navy.mil/cgi-bin/timer.pl 将我们带到仅在美国几个时区提供当前时间的网页.

For example the url http://tycho.usno.navy.mil/cgi-bin/timer.pl takes us to a webpage that has the current time only for a few time zones in the US.

推荐答案

您可以尝试在Personal.xls工作簿中找到以下类似内容(几个月后找到了类似的东西):

you could try something like the below which I have in my Personal.xls workbook (found it a few months back for something):

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

这篇关于Internet服务器VBA Excel的接送时间的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！