Log File for Excel Spreadsheet

  • Thread starter Thread starter terryspencer2003
  • Start date Start date
T

terryspencer2003

Is it possible to create a log file for an excel spreadsheeet that
does the following:

1) Logs username/ID/Computer Name upon opening,
2) Logs login time
3) Logs logout time
4) Logs whether excel file was opened read or write
4) Logs whether or nor changes have occured in the excel file while
open in write mode
5) Logs whether or not, the Excel file in question has been saved to
any drives other than the original source drive
6) Logs whether the excel file has been sent as an attatchment by
Outlook email

Thanks
TS
 
wrote:
Is it possible to create a log file for an excel spreadsheeet that
does the following:

1) Logs username/ID/Computer Name upon opening,
Yes - provided the user does not disable macros
2) Logs login time
Yes - provided the user does not disable macros
3) Logs logout time
Yes - provided the user does not disable macros and does not cancel
the closing of the workbook after your procedure has run (if so you may
log 2 or more logouts)
4) Logs whether excel file was opened read or write
Yes - provided the user does not disable macros
4) Logs whether or nor changes have occured in the excel file while
open in write mode
Oh! another 4) <grin>
Yes - provided the user does not disable macros, and provided that
you log the information before saves of the workbook
5) Logs whether or not, the Excel file in question has been saved to
any drives other than the original source drive
More difficult - I would say impossible.
6) Logs whether the excel file has been sent as an attatchment by
Outlook email
More difficult - I would say impossible.

To give you a start, you would put the macros as event procedures in
the ThisWorkbook module:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Open ThisWorkbook.Path & "\MyApp.Log" For Append As #1
Print #1, Now, "Closed by " & Application.UserName & " on " &
MachineName() & IIf(ThisWorkbook.Saved, "", " changed")
Close #1
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Open ThisWorkbook.Path & "\MyApp.Log" For Append As #1
Print #1, Now, "Saved by " & Application.UserName & " on " &
MachineName() & IIf(ThisWorkbook.Saved, "", " changed")
Close #1
End Sub

Private Sub Workbook_Open()
Open ThisWorkbook.Path & "\MyApp.Log" For Append As #1
Print #1, Now, "Opened by " & Application.UserName & " on " &
MachineName() & IIf(ThisWorkbook.ReadOnly, " read-only", "")
Close #1
End Sub

MachineName requires a Windows API call, so in a standard module:

''' Registry root key constants
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const HKEY_CURRENT_USER As Long = &H80000001

''' Registry key access constants
Public Const KEY_QUERY_VALUE As Long = &H1
Public Const KEY_SET_VALUE = &H2

''' Registry value data type constants.
Public Const REG_SZ As Long = 1

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA"
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long,
ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As
Long
Declare Function RegQueryValueStr Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String,
ByVal lpReserved As Long, lpType As Long, ByVal lpData As String,
lpcbData As Long) As Long


Function GetMachineName() As String
Dim lHandle As Long
Dim lResult As Long
Dim lReserved As Long
Dim lType As Long
Dim lLeng As Long
Dim stBuffer As String * 256
lReserved = 0
lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE,
"SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName", _
lReserved, KEY_QUERY_VALUE, lHandle)
If lResult = 0 Then
lLeng = 255
lReserved = 0
lResult = RegQueryValueStr(lHandle, "ComputerName", lReserved,
lType, stBuffer, lLeng)
If lResult = 0 And lType = REG_SZ Then
Machine = Left(stBuffer, lLeng - 1)
End If
RegCloseKey lHandle
End If
GetMachineName = Machine
End Function


Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - reply in newsgroup
 
Back
Top