How do I record a username and date
Midnite
I am trying to set up template so that all my workbooks have a similar
appearance. One of the major things I would like to do is that I would like
the workbook to record the username, date, and time of the person who has
opened the workbook. I would like for this information to be recorded on a
hidden worksheet as part of that workbook and password protected.
If I was to open the workbook using my username then I would like the hidden
worksheet to become visible.
The reason I need this is that I am having difficulties at work that my
workbooks are constantly being looked at on a network and sometimes
modified. This way I will know who and when someone has looked at my
workbook. I can password protect my workbooks but my boss would like for me
to share my workbooks.
Thanx in advance.
Midnite
Dave Peterson
Option Explicit
Option Private Module
Option Compare Text
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function apiGetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = ""
End If
End Function
Function fOSMachineName() As String
'Returns the computername
Dim lngLen As Long, lngX As Long
Dim strCompName As String
lngLen = 255
strCompName = String$(lngLen - 1, 0)
lngX = apiGetComputerName(strCompName, lngLen)
If lngX <> 0 Then
fOSMachineName = Left$(strCompName, lngLen)
Else
fOSMachineName = ""
End If
End Function
Sub auto_open()
Dim curUser As String
Dim curPC As String
Dim destCell As Range
curUser = fOSUserName
curPC = fOSMachineName
With Worksheets("secret")
If curUser = "yournamehere" Then
.Visible = xlSheetVisible
Else
.Visible = xlSheetVeryHidden
End If
Set destCell = .Cells(.Rows.Count, "A").End(xlUp)
If IsEmpty(destCell) Then
'do nothing
Else
Set destCell = destCell.Offset(1, 0)
End If
With destCell
.Offset(0, 0).Value = "'" & curUser
.Offset(0, 1).Value = "'" & curPC
With .Offset(0, 2)
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
.Value = Now
End With
End With
End With
ThisWorkbook.Save
End Sub
When you exit the workbook, make sure you hide that secret sheet--else there
will be a chance that the users can see the flash of the worksheet being shown,
then hidden.
And protect the project: In the VBE, Tools|VBA Project Properties|Protection
Tab.
And remember that if the user doesn't enable macros, this won't work.
Another option that might be better is to create a text file that keeps track of
the file. You don't have to do a save (might be important??).
If you have a network drive that all the users can write to, maybe something
like this:
Sub auto_open()
Dim myFileNumber As Long
myFileNumber = FreeFile
Close #myFileNumber
On Error Resume Next
Open "C:\my documents\excel\mylog.txt" For Append As myFileNumber
Print #myFileNumber, fOSUserName & vbTab & fOSMachineName _
& vbTab & ThisWorkbook.FullName & vbTab & Now
Close #myFileNumber
On Error GoTo 0
End Sub
Change "c:\my documents\excel\mylog.txt" to a nice name on a common drive.
The "on error" stuff is there because when I first did this in one of my
workbooks, it worked fine for people in my department. When someone tried to
open the file that didn't have write access to that drive (or weren't connected
to the network), it blew up real good.
I cared more about the real workbook working than the log file, so I just
"resumed next". It didn't bother me that someone could open it without me
knowing.
(But I did get to see who saved their own versions--instead of getting a fresh
copy. It was a volatile workbook and changes were being made quite often.)
--
Dave Peterson
ec3...@msn.com