Article ID: 198833
Article Last Modified on 1/23/2007
Form: frmOpeningMenu -------------------------------- Caption: Open and Close Database
Public SessionID As Long
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open
Dim db As Database
Dim rs As Recordset
Dim strLogName As String
Dim tdfLogTable As TableDef
Set db = CurrentDb
strLogName = "tblUsageLog"
Set tdfLogTable = db.TableDefs(strLogName)
Set rs = db.OpenRecordset(strLogName, dbOpenDynaset)
rs.AddNew
rs!User = CurrentUser
rs!Opened = Now
rs.Update
rs.MoveLast
SessionID = rs!LogID
Set tdfLogTable = Nothing
Set rs = Nothing
Set db = Nothing
Exit_Form_Open:
Exit Function
Err_Form_Open:
If Err.Number = 3265 Then
' Table does not exist
CreateLogTable (strLogName)
Resume Next
Else
MsgBox Err.Description
Resume Exit_Form_Open
End If
End Sub
Private Sub Form_Close()
On Error GoTo Err_Form_Close
Dim db As Database
Dim rs As Recordset
Dim strLogName As String
strLogName = "tblUsageLog"
Set db = CurrentDb
Set rs = db.OpenRecordset(strLogName, dbOpenDynaset)
rs.MoveLast
Do Until rs.BOF
If rs!LogID = SessionID Then
rs.Edit
rs!closed = Now
rs.Update
GoTo Exit_Form_Close
End If
rs.MovePrevious
Loop
Exit_Form_Close:
Application.CloseCurrentDatabase
Exit Sub
Err_Form_Close:
MsgBox Err.Description
Resume Exit_Form_Close
End Sub
Function CreateLogTable(strLogName As String)
Dim db As Database, td As TableDef, fld As Field
Set db = CurrentDb
Set td = db.CreateTableDef
td.Name = strLogName
Set fld = td.CreateField
fld.Name = "LogID"
fld.Type = dbLong
fld.Attributes = dbAutoIncrField
td.Fields.Append fld
Set fld = td.CreateField
fld.Name = "User"
fld.Type = dbText
td.Fields.Append fld
Set fld = td.CreateField
fld.Name = "Opened"
fld.Type = dbDate
td.Fields.Append fld
Set fld = td.CreateField
fld.Name = "Closed"
fld.Type = dbDate
td.Fields.Append fld
db.TableDefs.Append td
Set fld = Nothing
Set td = Nothing
End Function
Keywords: kbhowto kbprogramming KB198833