Link to home
Start Free TrialLog in
Avatar of Roland Garton
Roland Garton

asked on

Obtaining trustworthy time in Excel

Can anyone suggest ways for an Excel spreadsheet or VBA program to obtain exact time from the Internet?  There are cases where I don't want to trust the system clock on a user's computer.
Avatar of regmigrant
regmigrant
Flag of United Kingdom of Great Britain and Northern Ireland image

The best way is to make sure the pc you are using synchronises with a time server through your network or router and uses excels built-in functions but failing that the following code from a guy called Warner at Techarena might help - though depending on operating system revision, company policies etc you may or may not have access to the winsock library it references



Private Sub Command1_Click() 'Main button to set the system
    ' time
    On Error GoTo ErrHandler

    Label3.Caption = "System Time has Not been Set Yet"

    SetIt = 1 'Used to only set time if the time from the
        ' time server is valid and reportedly accurate

    If Winsock1.State <> sckClosing Then 'Sometimes the
        ' Winsock gets delayed in the closing state, so
        ' make sure it is closed before trying again
       If Winsock1.State = sckClosed Then 'If closed, ok to
           ' open, else close it
          Timer1.Interval = 5000 'Start 5 second count to
              ' 'time' server
          Timer1.Enabled = True
          Screen.MousePointer = vbHourglass
          Winsock1.LocalPort = 0 'Must be set to 0
          Winsock1.RemoteHost = Trim$(Text1.Text) 'Address
              ' of NIST server
          Winsock1.RemotePort = 13 '13, 37 or 123 'Use 13!
          Winsock1.Protocol = 0 '1-UDP '0-TCP 'USE TCP!
          Winsock1.Connect 'This is what goes out and gets
              ' the time
       Else
          Winsock1.Close
          Screen.MousePointer = vbNormal
          Timer1.Interval = 0
          Timer1.Enabled = False
       End If
    Else
       Winsock1.Close
       Screen.MousePointer = vbNormal
       Timer1.Interval = 0
       Timer1.Enabled = False
    End If
   
    Exit Sub
ErrHandler:
    SetIt = 0
    Screen.MousePointer = vbNormal
    Timer1.Interval = 0
    Timer1.Enabled = False
    MsgBox "The Winsock Connection is Unavailable."
    Winsock1.Close
End Sub
ASKER CERTIFIED SOLUTION
Avatar of nutsch
nutsch
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Roland,
note that you are in time zone -5 instead of -8 stated in the code.
@ nutsch: should -8 in your code simply be replaced with -5?
The whole url should be replaced by

http://time.gov/timezone.cgi?Eastern/d/-5, as in

   ie.NAVIGATE "http://time.gov/timezone.cgi?Eastern/d/-5"

Open in new window


T
et voila
no, et voila would be +1, this is -5.
Avatar of Roland Garton
Roland Garton

ASKER

Wow, I didn't know this was even possible.  It's really neat that you can do it.  

When I try this in my VBA for Excel 2007 code I get an error:  "Compile Error: User-defined type not defined," and it highlights the "objCollection As IHTMLElementCollection" part of the first Dim statement.  Is there some collection or resource I should set somewhere?

I need to run the resulting spreadsheet on various computers.  I can assume Excel 2007 if need be, but I can't assume any particular configuration.
Hi Roland,

you indeed need to reference the Microsoft HTML Object Library.
In your VBA editor (press ALt+F11 with your workbook activated), click Tools - References.
Then check the Microsoft HTML Object Library.

You'll need to do this on each PC you use the workbook on.

Regards,
Davy
Super -- thanks for this capability.  Several useful techniques embedded in this code.  I will likely use it in many other areas as well.

Thanks also to Davy for providing the key element of the correct references in VBA.
Always glad to help.
What about getting the date form the same webpage ?
Extract this line and you'll get it all

var NISTSendTime = new Date( "November 21, 2011 22:30:12")
Sub getTime()
    Dim objCollection As IHTMLElementCollection, links As IHTMLElementCollection, objItems As IHTMLElementCollection
    Dim objElement As IHTMLElement, link As HTMLAnchorElement, objItem As IHTMLElement, sBody As String
    Dim i As Long
    
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    
    ie.NAVIGATE "http://time.gov/timezone.cgi?Pacific/d/-8"

    Application.Wait Now + TimeValue("0:00:03")
    
    Set doc = ie.Document
    
    sBody = doc.body.innerHTML
    
dim sFullDate as string

    sFullDate=Mid(sBody, InStr(sBody, "NISTSendTime ") + 26, 50)
sfulldate=left(sfulldate,instr(sfulldate,")")-1)
    
debug.print sfulldate

    ie.Quit

End Sub

Open in new window