vba获取服务器信息及日期,出发时间从Internet服务器VBA的Excel(Pickup Time From Interne...

你可以尝试像下面，我有我的工作簿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