Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
Discussion GroupsFormsForms ProgrammingQueriesModules / DAO / VBAReports / PrintingMacrosDatabase DesignSecurityConversionImporting / LinkingSQL Server / ADPMultiuser / NetworkingReplicationSetup / ConfigurationDeveloper ToolkitsActiveX ControlsNew UsersGeneral 1General 2
Access DirectoryToolsTutorialsUser Groups
Related Topics
SQL ServerOther DB ProductsMS OfficeMore Topics ...

MS Access Forum / General 1 / August 2006

Tip: Looking for answers? Try searching our database.

VB Functions Dont Work with Workgroup Security

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
ricky.fung@gmail.com - 31 Aug 2006 03:48 GMT
I have several VBA functions in my Access Database that do not work.

I have a combobox that filters my subform data however I cannot select
anything when logged in with Read Only permission.

The statusbar comes up with a message saying:
"Recordset is not updatable"

This combobox works with Admin permissions but not Read Only.

Secondly I have a VBA function that does not work even with admin
permissions. It uses the following connection string:

strConnectionString = Application.CurrentProject.AccessConnection

I have a feeling this connection string is invalid when security has
been implemented so i guess the question is, is there a function I can
use to bypass security from a coding level or is there a way where I
can hardcode admin username and password for any VBA code.

Thanks in advance!
ricky.fung@gmail.com - 01 Sep 2006 00:46 GMT
Sorry the answer was so obvious and I totally missed it (I was
wondering why it worked on one form but not the other but then I
realised I was using a list box for the other form). Sorry my bad!

As for the code:
What the code does is, everytime a change is made on a form, the change
is recorded with details of the username and date recorded as well.
This information is then transferred into an audit table.

The following code captures the PK and passes into the Audit trail
function:

Private Sub Form_BeforeUpdate(Cancel As Integer)
   'if Billing Element Details are edited, then capture Audit data
   If Not IsNull(Me![Element ID]) And Me![Element ID] <> "" Then
       AuditTrail "Element Id", Me![Element ID],
Form_Subfrm_Billing_Single
   End If
End Sub

Below is the Audit Trail function

Option Compare Database
Option Explicit
Public strConnectionString As String

Public Sub AuditTrail(KeyFieldName As String, KeyFieldValue As String,
MyForm As Form)
   'Procedure Name - AuditTrail
   'Description    - This procedure captures the amendments done in
each and every fields of the Products, Hierarchy, Rules, Kenan, Seibel
tables
   'Parameters     - KeyFieldName  - Name of the Key Field that
uniquely identifies the modified record
   ' - KeyFieldValue - Value of the Key Field that uniquely identifies
the modified record
   ' - MyForm - Form Object that holds the reference to the Form in
which the amendments are made

   On Error GoTo Err_Handler
   Dim objConn As New ADODB.Connection
   Dim strSql As String
   Dim c As Control, xName As String
   strSql = ""

   'Connection string for Product Definition Database

   strConnectionString = Application.CurrentProject.AccessConnection

   'Set date and current user if form has been updated.
   MyForm!Updates = MyForm!Updates & Chr(13) & Chr(10) & _
   "Changes made on " & Date & " at - " & Time & " by " &
CurrentUser() & ";"

   'If new record, record it in audit trail and exit sub.
   If MyForm.NewRecord = True Then
       If Not IsNull(MyForm!Updates) And MyForm!Updates <> "" Then
           'New Record is not yet captured in Audit
           MyForm!Version = 1
           Dim strAddition As String    ' to capture Addition details
           If Left(KeyFieldName, 7) = "Element" Then
               If MyForm.Name = "SubFrm_Hierarchy_Element" Then
                   'New Element Addition
                   strAddition = "New Element - " & KeyFieldValue & "
added for Product - " & MyForm![Product]
               Else
                   Exit Sub
               End If
           Else
               'New Product Addition
               strAddition = "New Product - " & KeyFieldValue & "
added "
           End If
           MyForm!Updates = MyForm!Updates & Chr(13) & Chr(10) &
strAddition
           'Inserting Audit Information for the New Record
           objConn.ConnectionString = strConnectionString
           On Error GoTo DBAccess_Err
           objConn.Open
           strSql = "INSERT INTO TBL_AUDIT ([USER NAME], [CHANGE
DATE], [TABLE NAME]," _
           & " [KEY FIELD NAME], [KEY FIELD VALUE], [FIELD
CHANGED],CHANGES)" _
                   & " Values ('" & CurrentUser() & "' ,#" _
                   & Format(Date, "dd-MMM-yyyy") & " " & Format(Time,
"hh:mm:ss AMPM") & "# , '" & MyForm.RecordSource & "' ,'" _
                   & KeyFieldName & "','" & KeyFieldValue & "','','" _
                   & strAddition & "')"
           On Error GoTo QueryExecErr
           objConn.Execute strSql
           objConn.Close
       End If
   Else
       'if record is Edited, capture Audit Trail Data
       Dim strOldValue As String   'To store the Old Value of the form
control
       Dim bolInsert As Boolean    'Boolean value to check whether the
Audit log need to be inserted or not
       Dim intAuditCount As Integer
       intAuditCount = 0
       'Check each data entry control for change and record old value
of Control.
       For Each c In MyForm.Controls
           'Only check data entry type controls.
           Select Case c.ControlType
               Case acTextBox, acComboBox, acOptionGroup
                   bolInsert = False
                   strOldValue = ""
                   ' Skip Updates field and Version Field
                   If c.Name <> "Updates" And c.Name <> "Version" Then
                   ' If control was previously Null, record "previous
                   ' value was blank."
                       If (IsNull(c.OldValue) Or c.OldValue = "") Then
                           'check if some value has been inserted in
the blank field
                           'if so, record it in Audit Trail
                           If (Not IsNull(c.value) Or c.value <> "")
Then
                               MyForm!Updates = MyForm!Updates &
Chr(13) & _
                               Chr(10) & c.Name & " -- previous value
was blank"
                               strOldValue = "Blank "
                               bolInsert = True
                           End If
                       ' If control had previous value, record
previous value.
                       ' and it has been changed now, record it in
Audit Trail
                       ElseIf IIf(IsNull(c.value), "", c.value) <>
c.OldValue Then
                           strOldValue = c.OldValue
                           MyForm!Updates = MyForm!Updates & Chr(13) &
Chr(10) & _
                           c.Name & " == previous value was " &
c.OldValue
                           bolInsert = True
                       End If

                       If bolInsert = True Then
                           objConn.ConnectionString =
strConnectionString
                           On Error GoTo DBAccess_Err
                           objConn.Open
                           'Inserting Change details in AuditTrail
table
                           strSql = "INSERT INTO TBL_AUDIT ([USER
NAME], [CHANGE DATE], [TABLE NAME]," _
                           & " [KEY FIELD NAME], [KEY FIELD VALUE],
[FIELD CHANGED],CHANGES)" _
                                   & " Values ('" & CurrentUser() & "'
,#" _
                                   & Format(Date, "dd-MMM-yyyy") & " "
& Format(Time, "hh:mm:ss AMPM") & "# , '" & MyForm.RecordSource & "'
,'" _
                                   & KeyFieldName & "','" &
KeyFieldValue & "','" _
                                   & c.Name & "' , '" & strOldValue &
" --> " _
                                   & c.value & "')"
                           On Error GoTo QueryExecErr
                           objConn.Execute strSql
                           objConn.Close
                           intAuditCount = intAuditCount + 1
                       End If
                   End If
           End Select
       Next c
       If intAuditCount > 0 Then
           'Edit case, so increment the Version of the changes
           MyForm!Version = MyForm!Version + 1
       End If
   End If
   Set objConn = Nothing

TryNextC:
   Exit Sub

DBAccess_Err:
   MsgBox "Error Occured while Conencting to the Database." & vbCrLf &
Err.Description, vbCritical, "Audit Module"
   Exit Sub
QueryExecErr:
   MsgBox "Error occured while Inserting data in to Audit Trail" &
vbCrLf & Err.Description, vbCritical, "Audit Module"
   Resume Next
Err_Handler:
   If Err.Number <> 64535 Then
       MsgBox "Error occured while caoturing Audit Data " & vbCrLf &
"Description: " & Err.Description, vbCritical, "Audit Module"
   End If
   Resume TryNextC
End Sub

I hope this provides enough info to get a better understanding of my
problem.
Thanks!
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.