• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 461
  • Last Modified:

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.
0
RolandGarton
Asked:
RolandGarton
  • 5
  • 4
  • 2
  • +2
1 Solution
 
regmigrantCommented:
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
0
 
nutschCommented:
Might be off by a few seconds while the page loads, but you can use this, connecting to the Official US Time

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
    
    Debug.Print Mid(sBody, InStr(sBody, "white") + 16, 8)
    
    ie.Quit

End Sub

Open in new window

0
 
Davy2270Commented:
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?
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
nutschCommented:
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
0
 
Davy2270Commented:
et voila
0
 
nutschCommented:
no, et voila would be +1, this is -5.
0
 
Davy2270Commented:
:-)
0
 
RolandGartonAuthor Commented:
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.
0
 
Davy2270Commented:
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
0
 
RolandGartonAuthor Commented:
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.
0
 
Davy2270Commented:
Always glad to help.
0
 
vguzmanIT ManagerCommented:
What about getting the date form the same webpage ?
0
 
nutschCommented:
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

0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 5
  • 4
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now