Solved

VBA Code

Posted on 2011-03-25
5
226 Views
Last Modified: 2012-06-21
Hi,

Attached is some code i use to record when a user enters/exits a spreadsheet.

Does amyone have any code that can calculate the time difference i.e. the difference between entering and leaving

Thanks
Seamus
Private Sub Workbook_Open()


   With Application
      .DisplayAlerts = False
   End With
      ActiveWorkbook.UpdateLinks = xlUpdateLinksAlways


   With Application
      .DisplayAlerts = False
   End With




Debug.Print "open"
WriteFile Environ("USERNAME") & " entered at " & Now()
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Debug.Print "closed"
WriteFile Environ("USERNAME") & " left at " & Now()
End Sub

Sub WriteFile(strText As String)
   Dim MyFile As String, fNum As Integer
   MyFile = "\\ukhibmdata02\rights\Asset Services Risk Team\DCDIV002 Breaks\DCDIV.txt"
   'set and open file for output
   fNum = FreeFile()
   Open MyFile For Append As fNum
   'write project info and then a blank line. Note the comma is required
   Print #fNum, strText
   Write #fNum,
   Close #fNum

End Sub

Open in new window

0
Comment
Question by:Seamus2626
5 Comments
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 400 total points
ID: 35216696
Try this

Dim dt1 As Date, dt2 As Date
Private Sub Workbook_Open()
    Application.DisplayAlerts = False
    ActiveWorkbook.UpdateLinks = xlUpdateLinksAlways
    Application.DisplayAlerts = True
    dt1 = Now
    WriteFile Environ("USERNAME") & " entered at " & dt1
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    dt2 = Now
    WriteFile Environ("USERNAME") & " left at " & dt2
    WriteFile Environ("USERNAME") & " Time Difference " & Format(dt2 - dt1, "hh:mm:ss")
End Sub

Sub WriteFile(strText As String)
   Dim MyFile As String, fNum As Integer
   MyFile = "\\ukhibmdata02\rights\Asset Services Risk Team\DCDIV002 Breaks\DCDIV.txt"
   'set and open file for output
   fNum = FreeFile()
   Open MyFile For Append As fNum
   'write project info and then a blank line. Note the comma is required
   Print #fNum, strText
   Write #fNum,
   Close #fNum
End Sub

Open in new window


Sid
0
 
LVL 7

Assisted Solution

by:harr22
harr22 earned 100 total points
ID: 35216699
I would use an open event and stamp the current time somewhere in the sheet
then with a close event you can take the difference.

 
Private Sub Workbook_Open()
 Range("A1").Value = Now()
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 MsgBox ("File was Open for " & Now() - Range("A1").Value)
End Sub

Open in new window

0
 

Author Closing Comment

by:Seamus2626
ID: 35216722
Thanks guys!!
0
 
LVL 39

Expert Comment

by:nutsch
ID: 35216723
Put in a regular module

Global TimeEntered As Double

Open in new window


Then use it in your code (lines 14 and 23) as:

Private Sub Workbook_Open()


   With Application
      .DisplayAlerts = False
   End With
      ActiveWorkbook.UpdateLinks = xlUpdateLinksAlways


   With Application
      .DisplayAlerts = False
   End With

TimeEntered = Time()


Debug.Print "open"
WriteFile Environ("USERNAME") & " entered at " & Now()
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Debug.Print "closed"
WriteFile Environ("USERNAME") & " left at " & Now() & ", stayed " & Format(Time() - TimeEntered, "hh:mm:ss")
End Sub

Sub WriteFile(strText As String)
   Dim MyFile As String, fNum As Integer
   MyFile = "\\ukhibmdata02\rights\Asset Services Risk Team\DCDIV002 Breaks\DCDIV.txt"

Thomas
   'set and open file for output
   fNum = FreeFile()
   Open MyFile For Append As fNum
   'write project info and then a blank line. Note the comma is required
   Print #fNum, strText
   Write #fNum,
   Close #fNum

End Sub

Open in new window


Thomas
0
 

Author Comment

by:Seamus2626
ID: 35230562
Thanks for your contribution too Thomas.

Seamus
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now