Saturday, July 14, 2012

Getting Internet time via Excel VBA

Using VBA to automate Internet Explorer sessions from excel spreadsheet. The GetiNetTime subroutine is used to extract the date and time from web page "http://greenwichmeantime.com/".


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
'
'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'*'

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 = 5      'Hours.
    Mn = 30     '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:  IST " & 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


No comments:

Post a Comment