VBA, MS Access: Windows AD to access a table

Question

I have a MS Access DB with one Main Table in it.

20+ users. Their names are in one of the columns in the Main Table. I also have created User table (with User NameLastName and Win AD ID) I had created a split form for data updates and modification. There are some VBA modules involved. I'm working on having this: - every time User opens the form - it'll have pre-filtered records associated only to his/her Win AD ID name - the User won't be able to see/query on any other User's records

We have IDs that people use to login into their machines, could I utilize it in the VBA code for my above stated goal?

This is now how I filter for Users (Project Managers) in the combo box:

'Check if there is a value for Project Manager and build filter string
If Not IsNull(Me.cmbProjMang) And Me.cmbProjMang <> "" Then
    If intFilterSet Then
        strFilter = strFilter & " AND "
    End If

    strFilter = strFilter & "[PM] = " & Chr(34) & Me.cmbProjMang & Chr(34)
    intFilterSet = 1
End If

Would that function - possible part of the solution to my issue -Print Environ("UserName") be added here or in different Sub?

Thanks! MichMich

Kostas K. Kostas K. · Accepted Answer · 2017-05-12T06:23:10

Get the userid and filter the Form on Form_Load.

Place this in a standard module:

Option Explicit

'Username
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function Username() As String
    On Error GoTo ErrProc

    Dim lnglen As Long, lngX As Long, strName As String

    strName = String(254, 0)
    lnglen = 255
    lngX = apiGetUserName(strName, lnglen)

    If lngX <> 0 Then Username = Left(strName, lnglen - 1)

Leave:
    On Error GoTo 0
    Exit Function

ErrProc:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Function

Filter the Form:

Private Sub Form_Load()
    Dim user_ As String
        user_ = YourModuleName.Username

    With Me
        .Filter = "[Win AD ID]='" & user_ & "'"
        .FilterOn = True
    End With
End Sub

VBA, MS Access: Windows AD to access a table

1 Answers