Results 1 to 3 of 3
  1. #1
    Join Date
    Apr 2012
    Posts
    2

    Unanswered: MsAccess VBA Active Directory

    Hellow,

    I am trying to match sAMAccountName from active directory with my data in MS access Login name.
    My loginnames are in this structure:
    DOM8\Loginname
    So how can i split this field values,
    retrive sAMAccountname from Active directory,
    Match with the splitted data?

    Please give me some overall idea,if possible try to give some code.

    using;MS Access 2003,vba,sql

    Any help will be appriciated in advance.

  2. #2
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    The following class allow you to retrieve user domain information under different formats. The actual returned values may vary according to how the AD structure was set up.
    Code:
    Option Compare Database
    Option Explicit
    
    ' Windows API declarations.
    '
    Private Enum EXTENDED_NAME_FORMAT
        fNameUnknown = 0
        fNameFullyQualifiedDN = 1
        fNameSamCompatible = 2
        fNameDisplay = 3
        fNameUniqueId = 6
        fNameCanonical = 7
        fNameUserPrincipal = 8
        fNameCanonicalEx = 9
        fNameServicePrincipal = 10
        fNameDnsDomain = 12
    End Enum
    
    Private Declare Function GetComputerName Lib "Kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Private Declare Function GetUserNameEx Lib "secur32.dll" Alias "GetUserNameExA" ( _
                                           ByVal nFormat As EXTENDED_NAME_FORMAT, ByVal lpBuffer As String, ByRef nSize As Long) As Long
                                           
    Private Const c_NameUnknown As Long = 0
    Private Const c_FullyQualifiedDN As Long = 1
    Private Const c_SamCompatible As Long = 2
    Private Const c_Display As Long = 3
    Private Const c_UniqueId As Long = 6
    Private Const c_Canonical As Long = 7
    Private Const c_UserPrincipal As Long = 8
    Private Const c_CanonicalEx As Long = 9
    Private Const c_ServicePrincipal As Long = 10
    Private Const c_NameDnsDomain = 12
    
    Private m_strFormat As String
    Private m_booNormalizeName As Boolean
    
    ' = [STDC]{Begin} =====================================================================
    ' =
    ' =         ---------------------------------------
    ' =         *            Cls_Std_  Class          *
    ' =         ---------------------------------------
    ' =
    ' =         This section is common  to all Cls_Std classes.
    ' =
    
    Private Const c_strStd_ClassName As String = "Cls_Std_NTDomain"
    Private Const c_strStd_ClassGUID As String = "{B2AD9914-D15F-4A33-9CA6-BE20B629F095}"
    Private Const c_strStd_ClassBuild As String = "20111012-2.1.5"
    
    '  Private m_clsIdentity As Cls_Std_Identity
    
    Public Property Get ClassBuild() As String
    
        ClassBuild = c_strStd_ClassBuild
        
    End Property
    
    Public Property Get ClassGUID() As String
    
        ClassGUID = c_strStd_ClassGUID
        
    End Property
    
    Public Property Get ClassName() As String
    
        ClassName = c_strStd_ClassName
        
    End Property
    
    '  Public Property Get Identity() As String
    
    '      Identity = m_clsIdentity.Identity
    
    '  End Property
    '
    ' = [STDC]{End} =======================================================================
    '
    
    Private Sub Class_Initialize()
    
    '      Set m_clsIdentity = New Cls_Std_Identity
        
    End Sub
    
    Private Sub Class_Terminate()
    
    '      Set m_clsIdentity = Nothing
        
    End Sub
    
    
    Public Function GetNTComputer() As String
    
    ' Retrieve the name of the computer.
    '
        Dim strComputerName As String
        Dim lngComputerNameSize As Long
        
        strComputerName = String$(255, 0)
        lngComputerNameSize = Len(strComputerName)
        GetComputerName strComputerName, lngComputerNameSize
        strComputerName = Left$(strComputerName, lngComputerNameSize)
        GetNTComputer = strComputerName
    
    End Function
    
    Public Function GetNTDomainUser(Optional ByVal NameFormat As Long = c_SamCompatible, _
                                    Optional ByVal Normalize As Variant) As String
    
    ' Retrieve the Domain name of the current user.
    '
    ' The format varies according to the value of NameFormat:
    '
    '     0   NameUnknown            DON'T USE
    '     1   NameFullyQualifiedDN   CN=LASTNAME Firstname,OU=users,OU=organisationalunit,DC=domainmajor,DC=domainminor
    '     2   NameSamCompatible      DOMAINMAJOR-DOMAINMINOR\firstname.lastname
    '     3   NameDisplay            LASTNAME firstname
    '     6   NameUniqueId           {04d79494-5826-4443-9e3f-0f7087c85ab3}
    '     7   NameCanonical          domainmajor.domainminor/organisationalunit/users/LASTNAME firstname
    '     8   NameUserPrincipal      Firstname.LASNAME@domainmajor.domainminor
    '     9   NameCanonicalEx        DON'T USE
    '    10   NameServicePrincipal   domainmajor.domainminor/organisationalunit/users/LASTNAME Firstname
    '    12   NameDnsDomain          DOMAINMAJOR-DOMAINMINOR\firstname.lastname
    '
        Dim strUserName As String
        Dim lngUserNameSize As Long
        
        If IsEmpty(Normalize) Then Normalize = m_booNormalizeName
        Select Case NameFormat
            Case 0, 9
                strUserName = "<DON'T USE>"
            Case 1, 2, 3, 6, 7, 8, 10, 12
                strUserName = String$(255, 0)
                lngUserNameSize = Len(strUserName)
                If GetUserNameEx(NameFormat, strUserName, lngUserNameSize) <> 0 Then
                    strUserName = Left$(strUserName, lngUserNameSize - 1)
                    If Normalize = True Then strUserName = NormalizeName(strUserName)
                Else
                    strUserName = ""
                End If
            Case Else
                Err.Raise 452
        End Select
        GetNTDomainUser = strUserName
        
    End Function
    
    Public Function GetNTUser(Optional ByVal Normalize As Variant) As String
    
    ' Retrieve the login name of the current user.
    '
    ' If Normalize is True, the accented characters
    ' are converted into their unaccented counterparts.
    '
        Dim strUserName As String
        Dim lngUserNameSize As Long
        
        If IsEmpty(Normalize) Then Normalize = m_booNormalizeName
        strUserName = String$(255, 0)
        lngUserNameSize = Len(strUserName)
        GetUserName strUserName, lngUserNameSize
        strUserName = Left$(strUserName, lngUserNameSize - 1)
        If Normalize = True Then strUserName = NormalizeName(strUserName)
        GetNTUser = strUserName
        
    End Function
    
    Public Function GetNTDomain(Optional ByVal Normalize As Variant) As String
    
    ' Retrieve the name of the Domain for the current user.
    '
        Dim strDomainName As String
        
        If IsEmpty(Normalize) Then Normalize = m_booNormalizeName
        strDomainName = GetNTDomainUser(c_SamCompatible)
        If Len(strDomainName) > 0 Then
            If InStr(strDomainName, "\") > 0 Then strDomainName = Left(strDomainName, InStr(strDomainName, "\") - 1)
            If Normalize = True Then strDomainName = NormalizeName(strDomainName)
        End If
        GetNTDomain = strDomainName
        
    End Function
    
    Private Function NormalizeName(ByVal Name As String) As String
    
    ' Convert the accented characters into their unaccented counterparts
    ' and returns the converted input string in lowercase.
    '
        Dim strRetVal As String
        
        strRetVal = LCase(Name)
        strRetVal = Replace(strRetVal, "", "a")
        strRetVal = Replace(strRetVal, "", "a")
        strRetVal = Replace(strRetVal, "", "a")
        strRetVal = Replace(strRetVal, "", "c")
        strRetVal = Replace(strRetVal, "", "e")
        strRetVal = Replace(strRetVal, "", "e")
        strRetVal = Replace(strRetVal, "", "e")
        strRetVal = Replace(strRetVal, "", "e")
        strRetVal = Replace(strRetVal, "", "i")
        strRetVal = Replace(strRetVal, "", "i")
        strRetVal = Replace(strRetVal, "", "i")
        strRetVal = Replace(strRetVal, "", "i")
        strRetVal = Replace(strRetVal, "", "n")
        strRetVal = Replace(strRetVal, "", "o")
        strRetVal = Replace(strRetVal, "", "o")
        strRetVal = Replace(strRetVal, "", "o")
        strRetVal = Replace(strRetVal, "", "o")
        strRetVal = Replace(strRetVal, "", "u")
        strRetVal = Replace(strRetVal, "", "u")
        strRetVal = Replace(strRetVal, "", "u")
        strRetVal = Replace(strRetVal, "", "u")
        NormalizeName = strRetVal
        
    End Function
    
    Public Property Get NormalizedName() As Boolean
    
        NormalizedName = m_booNormalizeName
    
    End Property
    
    Public Property Let NormalizedName(ByVal Value As Boolean)
    
        m_booNormalizeName = Value
    
    End Property
    
    Public Property Get NameFullyQualifiedDN() As Long
    
        NameFullyQualifiedDN = c_FullyQualifiedDN
    
    End Property
    
    Public Property Get NameSamCompatible() As Long
    
        NameSamCompatible = c_SamCompatible
    
    End Property
    
    Public Property Get NameDisplay() As Long
    
        NameDisplay = c_Display
    
    End Property
    
    Public Property Get NameUniqueId() As Long
    
        NameUniqueId = c_UniqueId
    
    End Property
    
    Public Property Get NameCanonical() As Long
    
        NameCanonical = c_Canonical
    
    End Property
    
    Public Property Get NameUserPrincipal() As Long
    
        NameUserPrincipal = c_UserPrincipal
    
    End Property
    
    Public Property Get NameCanonicalEx() As Long
    
        NameCanonicalEx = c_CanonicalEx
    
    End Property
    
    Public Property Get NameServicePrincipal() As Long
    
        NameServicePrincipal = c_ServicePrincipal
    
    End Property
    Have a nice day!

  3. #3
    Join Date
    Apr 2012
    Posts
    2
    Thanks for code.
    But can u please help me in my design.
    step1
    declaration of variable.
    step2
    set up objects,connection.
    step3
    SQL statement
    objCommand.CommandText = "SELECT sAMAccountName " & _
    "FROM 'LDAP://path'"
    'Debug.Print objCommand.CommandText
    Set rsADSAMAccountName = objCommand.Execute
    step4:
    how can i open my table("Tablename_DataAD") and split my field value which is in strucrure'DOM\xyz'.
    Store in a variable and compare with the rsADSAMAccountName.
    If found "Active"
    If not"not Active"

    Please provide me some code,which will help me a lot.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •