Question

我目前正在尝试使用带有VisualBasic编码的Microsoft Access创建基本的商店数据库，并使用混合的在线教程来创建功能全面的审核跟踪。但是，我对视觉基础知识还很陌生，并且只有两到三个星期的经验。

由于此，我在审核的UserName部分遇到了麻烦，因为它给了我计算机帐户用户名，而不是数据库登录名。

我正在使用的当前代码：

Sub AuditChanges(IDField As String, UserAction As String)
      On Error GoTo AuditChanges_Err
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim ctl As Control
    Dim datTimeCheck As Date
    Dim strUserID As String
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    Dim Test As String
    Test = "EDIT"
    Select Case UserAction
        Case Test
            For Each ctl In Screen.ActiveForm.Controls
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![DateTime] = datTimeCheck
                            ![UserName] = strUserID
                            ![FormName] = Screen.ActiveForm.Name
                            ![Action] = UserAction
                            ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.OldValue
                            ![NewValue] = ctl.Value
                            .Update
                        End With
                    End If
                End If
            Next ctl
        Case Else
            With rst
                .AddNew
                ![DateTime] = datTimeCheck
                ![UserName] = strUserID
                ![FormName] = Screen.ActiveForm.Name
                ![Action] = UserAction
                ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                .Update
            End With
    End Select
AuditChanges_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
AuditChanges_Err:
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChanges_Exit
End Sub

任何帮助将不胜感激。

谢谢

Answer 1

正如@RyanWildry提到的那样，您的自定义登录名将决定如何检索当前数据库的用户名。假设表单登录，有几种方法可以检索要在审计跟踪中使用的当前用户：

TABLE ：将用户存储在诸如单行 CurrentUser 之类的表中，该表在成功登录后会更新：
```
User      StartTime
Jane Doe  2018-12-31 12:00
```
成功登录后将触发操作查询：
```
UPDATE [CurrentUser] SET [User] = Forms!DatabaseLogin!UserName, StartTime = Now();
```
然后在审核跟踪中，用DLookUp分配给表，替换Environ("UserName")：
```
...
strUserID = DLookUp("[User]", "[CurrentUser]")
...
```
FORM ：使用非常登录的表单，尤其是用户看不到的隐藏表单。用户输入凭据后，将数据库登录表单隐藏起来，以使其仍可用于检索文本框值：
```
Forms!DatabaseLogin.Visible = True
```
然后在您的审核跟踪中，分配给表单值，并替换Environ("UserName")：
```
...
strUserID = Forms!DatabaseLogin!UserName
...
```

变量：在登录后设置的标准模块（即不位于任何表单/报告的后面）中使用全局VBA变量，该变量在整个应用程序会话期间保持不变或与下一个用户重置：

Option Compare Database              ' MS ACCESS DEFAULT
Option Explicit                      ' BEST PRACTICE TO ADD

Public CurrentUserName As String     ' PLACE OUTSIDE OF ANY FUNCTION/SUB

' CALL SUB ROUTINE AFTER LOGIN
Sub SetUser()
    CurrentUserName = Forms!DatabaseLogin!UserName
End SetUser

然后在您的审核跟踪中，分配给全局变量，并替换Environ("UserName")：

...
strUserID = CurrentUserName
...

数据库用户名中的审计跟踪未注册

1 个答案: