Simple Audit Trail? 2

[BennyWong]

Hello All,
I am currently using Access 2000. I have a mailing list database which I would like to add a simple audit trail to record when a user exports out the whole database into Excel. This is important to the Management to maintain security of the information of the clients in the database. Currently, I have a form which contains a button. When the button is depressd it then runs a query and then exports the complete database into the client's local hard drive. Here is the current code:

Private Sub Command6_Click()
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryDBTOEXCEL", "c:\COMPLETE_DB.xls"
MsgBox "Your Spreadsheet has been created and is located on your local computer hard drive C:\COMPLETE_DB.xls"
End Sub


I currently have a table named tblExport with the fields:
date, user, and computer name. How can I update this table tblExport each time when the user depress this button?
I am new to VBA and any help is appreciated in advance. Thank you very much for your time.

 

[nealvenables]

Hi,


Try this...

dim adoCMD as new adodb.command
dim strSQL as string

<your TransferSpreadsheet and msgbox code here>

strSQL = _
&quot;INSERT INTO tblExport (User, [Computer Name], [Date]) &quot; & _
&quot;SELECT '&quot; & Environ(&quot;username&quot;) & &quot;' as Expr1, &quot; & _
&quot;'&quot; & Environ(&quot;computername&quot;) & &quot;' as Expr2, &quot; & _
&quot;now() as Expr3;&quot;

adoCMD.ActiveConnection = CurrentProject.Connection
adoCMD.CommandType = adCmdText
adoCMD.CommandText = strSQL
adoCMD.Execute

Good luck - let me know if this helps.

 

[FancyPrairie]

Try the following (need to add Micosoft DAO 3.6 Object Library as a reference via Tools|References...

Private Declare Function api_GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Sub Command6_Click()

Dim dbs as DAO.Database
Dim rst as DAO.Recordset

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryDBTOEXCEL", "c:\COMPLETE_DB.xls"
MsgBox "Your Spreadsheet has been created and is located on your local computer hard drive C:\COMPLETE_DB.xls"

Set dbs = CurrentDB
set rst = dbs.OpenRecordset("Select * from YourAuditTable Where User = '" & CurrentUser & "';&quot
if (rst.bof) and (rst.eof) then
rst.AddNew
rst!strUser = CurrentUser
else
rst.Edit
End If
rst!dtmTransfer = Now()
rst!strComputerName = GetComputerName
rst.Update
rst.Close

End Sub

Public Function GetComputerName() As String

Dim strBuffer As String
Dim lngSize As Long
Dim lngWork As Long

lngSize = 256
strBuffer = Space$(lngSize)


lngWork = api_GetComputerName(strBuffer, lngSize)
GetComputerName = Trim$(strBuffer)

End Function

 

[BennyWong]

Hello FancyPrairie,
Thanks for your response. I tried the code but I get a Run-Time Error '3265' - Item not found in this collection.
The error is on the line: rst!struser=currentuser

Here is the code:

Private Declare Function api_GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Sub Export_To_Excel_Click()

Dim dbs As DAO.Database
Dim rst As DAO.Recordset

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryDBTOEXCEL", "c:\COMPLETE_DB.xls"
MsgBox "Your Spreadsheet has been created and is located on your local computer hard drive C:\COMPLETE_DB.xls"

Set dbs = CurrentDb
' Set rst = dbs.OpenRecordset("Select * from tblExport Where User = '" & CurrentUser & "';&quot
Set rst = dbs.OpenRecordset("Select * from tblExport Where User = '" & CurrentUser & "';&quot
If (rst.BOF) And (rst.EOF) Then
rst.AddNew
rst!strUser = CurrentUser <--- error here
Else
rst.Edit
End If
rst!dtmTransfer = Now()
rst!strComputerName = GetComputerName
rst.Update
rst.Close

End Sub

Public Function GetComputerName() As String

Dim strBuffer As String
Dim lngSize As Long
Dim lngWork As Long

lngSize = 256
strBuffer = Space$(lngSize)


lngWork = api_GetComputerName(strBuffer, lngSize)
GetComputerName = Trim$(strBuffer)

End Function

I am still a novice with VBA, so I don't totally understand what is going on. Feel free to comment what is
happening. I really appreiciate you taking the time in assisting me. Thanks in advance for your response.

Benny Wong

 

[BennyWong]

Hello Nealy,
Thanks for your response. I really appreciate all the help from this website. Anyway, I tried your code and compiled it just fine. I ran it and the export went fine but I get a Run Time error '-2147217900(80040e14)': Syntax Error in insert into statement. The complier stop at the line towards the end : ado cmd.execute. This was highlighted in yellow. I tried reset and compile again and tried it and again same error. The export spreadsheet worked fine.
Thanks for your continued support in advance. I am a novice in VBA and would appreciate if you can comment what is happening. Thanks for your time.

 

[FancyPrairie]

My mistake. I referred to a variable with 2 different names. However, you need to change the names to match the name you gave in your table. (User and strUser should be the same name)

Set rst = dbs.OpenRecordset(&quot;Select * from tblExport Where User = '&quot; & CurrentUser & &quot;';&quot
If (rst.BOF) And (rst.EOF) Then
rst.AddNew
rst!strUser = CurrentUser

 

[BennyWong]

Hello FancyPrairie,
Thanks for your continued support. I tried changing what you suggested but still get runtime error. Here is the code result:

Run-time error &quot;3265':
Item not found in this collection.

Option Compare Database
Private Declare Function api_GetComputerName Lib &quot;kernel32&quot; Alias &quot;GetComputerNameA&quot; (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Export_To_Excel_Click()

Dim dbs As DAO.Database
Dim rst As DAO.Recordset

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, &quot;qryDBTOEXCEL&quot;, &quot;c:\COMPLETE_DB.xls&quot;
MsgBox &quot;Your Spreadsheet has been created and is located on your local computer hard drive C:\COMPLETE_DB.xls&quot;

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(&quot;Select * from tblExport Where User = '&quot; & User & &quot;';&quot
If (rst.BOF) And (rst.EOF) Then
rst.AddNew
rst!User = CurrentUser
Else
rst.Edit
End If
rst!dtmTransfer = Now() <-------------- error in yellow
rst!strComputerName = GetComputerName
rst.Update
rst.Close

End Sub

Public Function GetComputerName() As String

Dim strBuffer As String
Dim lngSize As Long
Dim lngWork As Long

lngSize = 256
strBuffer = Space$(lngSize)


lngWork = api_GetComputerName(strBuffer, lngSize)
GetComputerName = Trim$(strBuffer)

End Function

I'm not sure what is going on at the error area. I tried changing: rst!dtmTransfer = Now()
to rst!dateTransfer = Now() - didn't work. Does it mean something is missing? Anyway, I appreciate all your efforts in troubleshooting this issue. Thanks for your continued support in advance.

Benny Wong

 

[FancyPrairie]

I guess I assumed too much. You will need to modify my code so that it references the names you setup in your table. For example, assume your table has 3 fields: User Name, date/time transferred, and computer name. (I prefer naming conventions. Therefore, I would name the 3 fields as:

strUserName
dtmTransfer
strComputerName

If your field names are not the same as mine, either change mine to yours or yours to mine.

You should also use Option Explicit in all of your modules. This forces you to declare all variables. Consequently, if you misspell a variable name, the compiler will catch it. To force Option Explicit, in the code module view, goto Tools|Options and select the Editor tab and check the item labeled &quot;Require Variable Declaration.&quot;

Option Compare Database
Option Explicit

Private Declare Function api_GetComputerName Lib &quot;kernel32&quot; Alias &quot;GetComputerNameA&quot; (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Export_To_Excel_Click()

Dim dbs As DAO.Database
Dim rst As DAO.Recordset

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, &quot;qryDBTOEXCEL&quot;, &quot;c:\COMPLETE_DB.xls&quot;
MsgBox &quot;Your Spreadsheet has been created and is located on your local computer hard drive C:\COMPLETE_DB.xls&quot;

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(&quot;Select * from tblExport Where strUserName = '&quot; & CurrentUser & &quot;';&quot
If (rst.BOF) And (rst.EOF) Then
rst.AddNew
rst!strUserName = CurrentUser
Else
rst.Edit
End If
rst!dtmTransfer = Now()
rst!strComputerName = GetComputerName
rst.Update
rst.Close

End Sub

Public Function GetComputerName() As String

Dim strBuffer As String
Dim lngSize As Long
Dim lngWork As Long

lngSize = 256
strBuffer = Space$(lngSize)


lngWork = api_GetComputerName(strBuffer, lngSize)
GetComputerName = Trim$(strBuffer)

End Function

One final thing, I refer to CurrentUser CurrentUser will always be Admin unless you have setup security on your system. If you have not, then you should replace CurrentUser with Environ(&quot;username&quot as nealv suggested in a previous post. Note, however, that I don't believe Environ works on Windows 9x machines.

 

[BennyWong]

Hello FancyPrarie,
THANK YOU! THANK YOU! THANK YOU! That did it!
I really appreciate your help and your time with the
quick response! Also Thanks to Nealv for his time and
efforts! Time for me to try to digest all the codes.

Benny Wong