tiredofit
Well-known Member
- Joined
- Apr 11, 2013
- Messages
- 1,926
- Office Version
- 365
- 2019
- Platform
- Windows
The following code, taken from here:
retrieves the internet time, ie even if you changed the date and time on your PC, this code will still return the correct date and time.
Can someone tell me if this there is some equivalent code that would work on a mac?
Thanks
Code:
https://stackoverflow.com/questions/16190812/pickup-time-from-internet-servers-vba-excel
retrieves the internet time, ie even if you changed the date and time on your PC, this code will still return the correct date and time.
Code:
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
Can someone tell me if this there is some equivalent code that would work on a mac?
Thanks