I have a VB application (.NET 4.0) where a user selects an AD group they own, then can add users from a predefined list to that group. The groups and pulled from AD and the users are pulled from Oracle but are all existing AD users.
You will see three commented code blocks, I have tried all three and get "COMException was unhandled by user code: Unspecified error" with each one.
<WebMethod()> _
Public Shared Function AddDirectReport(ByVal User As String, ByVal Group As String) As String
Dim GroupMembers As List(Of String) = LoadGroupMembers(Group)
If GroupMembers.Contains(User) Then
Return "USER " & User & " IS ALREADY IN GROUP " & Group
End If
Dim SearchRoot As New DirectoryEntry("[LDAP Path]")
Dim GroupSearcher As New DirectorySearcher
With GroupSearcher
.SearchRoot = SearchRoot
.Filter = "(&(ObjectClass=Group)(CN=" & Group & "))"
End With
Dim UserSearcher As New DirectorySearcher
With UserSearcher
.SearchRoot = SearchRoot
.Filter = "(&(ObjectClass=Person)(CN=" & User & "))"
End With
Dim g As DirectoryEntry = GroupSearcher.FindOne.GetDirectoryEntry
Dim u As DirectoryEntry = UserSearcher.FindOne.GetDirectoryEntry
'With u
' .Properties("memberof").Add(g)
' .CommitChanges()
'End With
'With g
' .Properties("member").Add(u)
' .CommitChanges()
'End With
'With g
' .Properties("members").Add(u)
' .CommitChanges()
'End With
Return "Success?"
End Function
This is a great resource.
In it, you'll find that your second was almost there. Instead of passing the DirectoryEntry to the add method, you need its distinguished name:
With g
.Properties("member").Add(u.Properties("distinguishedName").Value)
.CommitChanges()
End With
Related
I am trying to retrieve the email address for a known Active Directory user by using their login ID and the DirectorySearcher.FindOne() method in VB.Net but I have been unable to get any results.
Sorry but I am new to VB.Net and do not know where I am going wrong. I have tried using various examples that I have found on the net but they all are in C#. I have been able to convert the code to VB but I am still not able to pull results using what I have found. In the latest example I found here! it is using the FindAll() method and putting the results in a SearchResultCollection object. The collection ended up with a count of 0 so I have tried using the FindOne() method and tried to put the result in a SearchResult object. This didn't work for me either.
Public Shared Sub RetrieveUser(ByVal username As String)
Dim propUsername As String = "samaccountname"
Dim propFirstName As String = "givenName"
Dim propLastName As String = "sn"
Dim propDisplayName As String = "cn"
Dim propMail As String = "mail"
Dim propGuid As String = "objectguid"
Dim results As SearchResultCollection
Dim result As SearchResult
Dim directoryEntry As DirectoryEntry = New DirectoryEntry("LDAP_PATH", "DOMIAIN\USERNAME", "PASSWORD", AuthenticationTypes.ServerBind)
Using directorySearcher As DirectorySearcher = New DirectorySearcher(directoryEntry)
directorySearcher.PropertiesToLoad.Add(propUsername)
directorySearcher.PropertiesToLoad.Add(propDisplayName)
directorySearcher.PropertiesToLoad.Add(propFirstName)
directorySearcher.PropertiesToLoad.Add(propLastName)
directorySearcher.PropertiesToLoad.Add(propMail)
directorySearcher.PropertiesToLoad.Add(propGuid)
directorySearcher.Filter = String.Format("({0})", "&(objectClass=user)(cn=" & username & ")")
directorySearcher.SearchScope = SearchScope.Subtree
' directorySearcher.SearchRoot.AuthenticationType = AuthenticationTypes.Secure
directorySearcher.PageSize = 100
'results = directorySearcher.FindAll()
result = directorySearcher.FindOne()
'For Each result In results
If result.Properties.Contains(propUsername) Then
Console.WriteLine("User Name: " & result.Properties(propUsername)(0))
End If
If result.Properties.Contains(propGuid) Then
Console.WriteLine("User GUID: " & BitConverter.ToString(CType(result.Properties(propGuid)(0), Byte())).Replace("-", String.Empty))
End If
If result.Properties.Contains(propMail) Then
Console.WriteLine("Mail ID: " & result.Properties(propMail)(0))
End If
If result.Properties.Contains(propDisplayName) Then
Console.WriteLine("DisplayName: " & result.Properties(propDisplayName)(0))
End If
'Next
directorySearcher.Dispose()
directoryEntry.Dispose()
End Using
End Sub
I needed to add users to Active Directory using VB. I found code that works (mostly), except for assigning the user to a group. I'm fairly certain that the code works, I just don't know the format of the group to pass to it.
Given the code (below), and the image of my AD structure (below that), what is the structure of the GroupName passed to the routine to add the user to the group "Level1/All Users/Level 2/A-K"?
TIA
Public Shared Sub AddUserToGroup(ByVal de As DirectoryEntry, ByVal deUser As DirectoryEntry, ByVal GroupName As String)
Dim deSearch As DirectorySearcher = New DirectorySearcher()
deSearch.SearchRoot = de
deSearch.Filter = "(&(objectClass=group) (cn=" & GroupName & "))"
Dim results As SearchResultCollection = deSearch.FindAll()
Dim isGroupMember As Boolean = False
If results.Count > 0 Then
Dim group As New DirectoryEntry(results(0).Path)
Dim members As Object = group.Invoke("Members", Nothing)
For Each member As Object In CType(members, IEnumerable)
Dim x As DirectoryEntry = New DirectoryEntry(member)
Dim name As String = x.Name
If name <> deUser.Name Then
isGroupMember = False
Else
isGroupMember = True
Exit For
End If
Next member
If (Not isGroupMember) Then
group.Invoke("Add", New Object() {deUser.Path.ToString()})
End If
group.Close()
End If
Return
End Sub
According to your input from your comment I set up this Sub for you.
You havn't clarified the level below Level2 so I just called it Level3.
This function already enables User as a disabled User is useless...
References:
Imports System.DirectoryServices
How to Use:
CreateUser("Doe", "John")
Method:
Public Sub CreateUser(ByVal givenname As String, ByVal surname As String)
Dim dom As New DirectoryEntry()
Dim ou As DirectoryEntry = dom.Children.Find("OU=All Users")
Dim ou2 As DirectoryEntry = ou.Children.Find("OU=Level2")
Dim ou3 As DirectoryEntry = ou2.Children.Find("OU=Level3")
Dim firstLetter As String = givenname.Substring(0, 1)
Dim ou4 As DirectoryEntry
If firstLetter Like "*[A-K]*" Then
ou4 = ou3.Children.Find("OU=A-K")
Else
ou4 = ou3.Children.Find("OU=L-Z")
End If
Dim ADuser As DirectoryEntry = ou4.Children.Add("CN=" & givenname & "\, " & surname, "user")
ADuser.CommitChanges()
'The User is now created. Most people forget to enable their users so I'll put it in here too
'UF_DONT_EXPIRE_PASSWD 0x10000
Dim exp As Integer = CInt(ADuser.Properties("userAccountControl").Value)
ADuser.Properties("userAccountControl").Value = exp Or &H1
ADuser.CommitChanges()
'UF_ACCOUNTDISABLE 0x0002
Dim val As Integer = CInt(ADuser.Properties("userAccountControl").Value)
ADuser.Properties("userAccountControl").Value = val And Not &H2
ADuser.CommitChanges()
End Sub
See my answer in this post for basic knowledge of interaction with AD and LDAP.
I have an MS Access database which now requires me to 'attach' documents to it. My intention is to store the documents on Google Drive and have a link on the database for users to retrieve the documents.
As there are many users spread through different cities, it is not practical to require them to have synced Google Drive folders. All the users will need the ability to upload to the database/GD so my intention is to have a separate Google account for the database - with its own login details.
example:
User clicks button to upload file
Save as dialog box appears and user selects file
Database logs into its Google Drive and uploads selected file
Lots of problems with this though, the main one being that Google Drive does not support VBA.
If the user is logged into their own Gmail account, that will probably be another issue.
I came across this code for vb.net on another site.
Imports System
Imports System.Diagnostics
Imports DotNetOpenAuth.OAuth2
Imports Google.Apis.Authentication.OAuth2
Imports Google.Apis.Authentication.OAuth2.DotNetOpenAuth
Imports Google.Apis.Drive.v2
Imports Google.Apis.Drive.v2.Data
Imports Google.Apis.Util
Imports Google.Apis.Services
Namespace GoogleDriveSamples
Class DriveCommandLineSample
Shared Sub Main(ByVal args As String)
Dim CLIENT_ID As [String] = "YOUR_CLIENT_ID"
Dim CLIENT_SECRET As [String] = "YOUR_CLIENT_SECRET"
'' Register the authenticator and create the service
Dim provider = New NativeApplicationClient(GoogleAuthenticationServer.Description, CLIENT_ID, CLIENT_SECRET)
Dim auth = New OAuth2Authenticator(Of NativeApplicationClient)(provider, GetAuthorization)
Dim service = New DriveService(New BaseClientService.Initializer() With { _
.Authenticator = auth _
})
Dim body As New File()
body.Title = "My document"
body.Description = "A test document"
body.MimeType = "text/plain"
Dim byteArray As Byte() = System.IO.File.ReadAllBytes("document.txt")
Dim stream As New System.IO.MemoryStream(byteArray)
Dim request As FilesResource.InsertMediaUpload = service.Files.Insert(body, stream, "text/plain")
request.Upload()
Dim file As File = request.ResponseBody
Console.WriteLine("File id: " + file.Id)
Console.WriteLine("Press Enter to end this process.")
Console.ReadLine()
End Sub
Private Shared Function GetAuthorization(ByVal arg As NativeApplicationClient) As IAuthorizationState
' Get the auth URL:
Dim state As IAuthorizationState = New AuthorizationState( New () {DriveService.Scopes.Drive.GetStringValue()})
state.Callback = New Uri(NativeApplicationClient.OutOfBandCallbackUrl)
Dim authUri As Uri = arg.RequestUserAuthorization(state)
' Request authorization from the user (by opening a browser window):
Process.Start(authUri.ToString())
Console.Write(" Authorization Code: ")
Dim authCode As String = Console.ReadLine()
Console.WriteLine()
' Retrieve the access token by using the authorization code:
Return arg.ProcessUserAuthorization(authCode, state)
End Function
End Class
End Namespace
It was suggested that the IE library could be utilised to log into the Google Drive and the API calls made from the above to upload. I don't know how to do this. Somewhere else it was mentioned that a 'COM wrapper' may be suitable. I don't have experience with any coding other than VBA (self taught) so am struggling to understand what the next step should be.
If anyone has done something similar or can offer any advice, I would be grateful to hear from you.
This thread might be dead now but if you are working with forms in your database and the user needs to be attaching the files to a particular record displayed in a form with a unique identification number then this is definitely possible but you would have to do it in an external application written in .NET I can provide you with the necessary code to get you started, vb.net is very similar to VBA.
What you would need to do is create a windows form project and add references to Microsoft access core dll and download the nugget package for google drive api from nugget.
Imports Google
Imports Google.Apis.Services
Imports Google.Apis.Drive.v2
Imports Google.Apis.Auth.OAuth2
Imports Google.Apis.Drive.v2.Data
Imports System.Threading
Public Class GoogleDriveAuth
Public Shared Function GetAuthentication() As DriveService
Dim ClientIDString As String = "Your Client ID"
Dim ClientSecretString As String = "Your Client Secret"
Dim ApplicationNameString As String = "Your Application Name"
Dim secrets = New ClientSecrets()
secrets.ClientId = ClientIDString
secrets.ClientSecret = ClientSecretString
Dim scope = New List(Of String)
scope.Add(DriveService.Scope.Drive)
Dim credential = GoogleWebAuthorizationBroker.AuthorizeAsync(secrets, scope, "user", CancellationToken.None).Result()
Dim initializer = New BaseClientService.Initializer
initializer.HttpClientInitializer = credential
initializer.ApplicationName = ApplicationNameString
Dim Service = New DriveService(initializer)
Return Service
End Function
End Class
This code will authorise your drive service then you create a Public Shared Service As DriveService under your imports that can be used from any sub or function then call this function on your form load event like
Service = GoogleDriveAuth.GetAuthentication
Add a reference to your project to Microsoft Access 12.0 Object Library or whatever version you have
Then this piece of code will look at the form you want to get the value of the record no from and upload a file to your choice of folder
Private Sub UploadAttachments()
Dim NumberExtracted As String
Dim oAccess As Microsoft.Office.Interop.Access.Application = Nothing
Dim connectedToAccess As Boolean = False
Dim SelectedFolderIdent As String = "Your Upload Folder ID"
Dim CreatedFolderIdent As String
Dim tryToConnect As Boolean = True
Dim oForm As Microsoft.Office.Interop.Access.Form
Dim oCtls As Microsoft.Office.Interop.Access.Controls
Dim oCtl As Microsoft.Office.Interop.Access.Control
Dim sForm As String 'name of form to show
sForm = "Your Form Name"
Try
While tryToConnect
Try
' See if can connect to a running Access instance
oAccess = CType(Marshal.GetActiveObject("Access.Application"), Microsoft.Office.Interop.Access.Application)
connectedToAccess = True
Catch ex As Exception
Try
' If couldn't connect to running instance of Access try to start a running Access instance And get an updated version of the database
oAccess = CType(CreateObject("Access.Application"), Microsoft.Office.Interop.Access.Application)
oAccess.Visible = True
oAccess.OpenCurrentDatabase("Your Database Path", False)
connectedToAccess = True
Catch ex2 As Exception
Dim res As DialogResult = MessageBox.Show("COULD NOT CONNECT TO OR START THE DATABASE" & vbNewLine & ex2.Message, "Warning", MessageBoxButtons.AbortRetryIgnore, MessageBoxIcon.Warning)
If res = System.Windows.Forms.DialogResult.Abort Then
Exit Sub
End If
If res = System.Windows.Forms.DialogResult.Ignore Then
tryToConnect = False
End If
End Try
End Try
' We have connected successfully; stop trying
tryToConnect = False
End While
' Start a new instance of Access for Automation:
' Make sure Access is visible:
If Not oAccess.Visible Then oAccess.Visible = True
' For Each oForm In oAccess.Forms
' oAccess.DoCmd.Close(ObjectType:=Microsoft.Office.Interop.Access.AcObjectType.acForm, ObjectName:=oForm.Name, Save:=Microsoft.Office.Interop.Access.AcCloseSave.acSaveNo)
' Next
' If Not oForm Is Nothing Then
' System.Runtime.InteropServices.Marshal.ReleaseComObject(oForm)
' End If
' oForm = Nothing
' Select the form name in the database window and give focus
' to the database window:
' oAccess.DoCmd.SelectObject(ObjectType:=Microsoft.Office.Interop.Access.AcObjectType.acForm, ObjectName:=sForm, InDatabaseWindow:=True)
' Show the form:
' oAccess.DoCmd.OpenForm(FormName:=sForm, View:=Microsoft.Office.Interop.Access.AcFormView.acNormal)
' Use Controls collection to edit the form:
oForm = oAccess.Forms(sForm)
oCtls = oForm.Controls
oCtl = oCtls.Item("The Name Of The Control Where The Id Number Is On The Form")
oCtl.Enabled = True
' oCtl.SetFocus()
NumberExtracted = oCtl.Value
System.Runtime.InteropServices.Marshal.ReleaseComObject(oCtl)
oCtl = Nothing
' Hide the Database Window:
' oAccess.DoCmd.SelectObject(ObjectType:=Microsoft.Office.Interop.Access.AcObjectType.acForm, ObjectName:=sForm, InDatabaseWindow:=True)
' oAccess.RunCommand(Command:=Microsoft.Office.Interop.Access.AcCommand.acCmdWindowHide)
' Set focus back to the form:
' oForm.SetFocus()
' Release Controls and Form objects:
System.Runtime.InteropServices.Marshal.ReleaseComObject(oCtls)
oCtls = Nothing
System.Runtime.InteropServices.Marshal.ReleaseComObject(oForm)
oForm = Nothing
' Release Application object and allow Access to be closed by user:
If Not oAccess.UserControl Then oAccess.UserControl = True
System.Runtime.InteropServices.Marshal.ReleaseComObject(oAccess)
oAccess = Nothing
If NumberExtracted = Nothing Then
MsgBox("The Number Could Not Be Obtained From The Form" & vbNewLine & vbNewLine & "Please Ensure You Have The Form Open Before Trying To Upload")
Exit Sub
End If
If CheckForDuplicateFolder(SelectedFolderIdent, NumberExtracted + " - ATC") = True Then
CreatedFolderIdent = GetCreatedFolderID(NumberExtracted + " - ATC", SelectedFolderIdent)
DriveFilePickerUploader(CreatedFolderIdent)
Else
CreateNewDriveFolder(NumberExtracted + " - ATC", SelectedFolderIdent)
CreatedFolderIdent = GetCreatedFolderID(NumberExtracted + " - ATC", SelectedFolderIdent)
DriveFilePickerUploader(CreatedFolderIdent)
End If
Catch EX As Exception
MsgBox("The Number Could Not Be Obtained From The Form" & vbNewLine & vbNewLine & "Please Ensure You Have The Form Open Before Trying To Upload" & vbNewLine & vbNewLine & EX.Message)
Exit Sub
Finally
If Not oCtls Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oCtls)
oCtls = Nothing
End If
If Not oForm Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oForm)
oForm = Nothing
End If
If Not oAccess Is Nothing Then
System.Runtime.InteropServices.Marshal.ReleaseComObject(oAccess)
oAccess = Nothing
End If
End Try
End
End Sub
Check For Duplicate Folders In The Destination Upload Folder
Public Function CheckForDuplicateFolder(ByVal FolderID As String, ByVal NewFolderNameToCheck As String) As Boolean
Dim ResultToReturn As Boolean = False
Try
Dim request = Service.Files.List()
Dim requeststring As String = ("'" & FolderID & "' in parents And mimeType='application/vnd.google-apps.folder' And trashed=false")
request.Q = requeststring
Dim FileList = request.Execute()
For Each File In FileList.Items
If File.Title = NewFolderNameToCheck Then
ResultToReturn = True
End If
Next
Catch EX As Exception
MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
End Try
Return ResultToReturn
End Function
Create New Drive Folder
Public Sub CreateNewDriveFolder(ByVal DirectoryName As String, ByVal ParentFolder As String)
Try
Dim body1 = New Google.Apis.Drive.v2.Data.File
body1.Title = DirectoryName
body1.Description = "Created By Automation"
body1.MimeType = "application/vnd.google-apps.folder"
body1.Parents = New List(Of ParentReference)() From {New ParentReference() With {.Id = ParentFolder}}
Dim file1 As Google.Apis.Drive.v2.Data.File = Service.Files.Insert(body1).Execute()
Catch EX As Exception
MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
End Try
End Sub
Get The Created Folder ID
Public Function GetCreatedFolderID(ByVal FolderName As String, ByVal FolderID As String) As String
Dim ParentFolder As String
Try
Dim request = Service.Files.List()
Dim requeststring As String = ("'" & FolderID & "' in parents And mimeType='application/vnd.google-apps.folder' And title='" & FolderName & "' And trashed=false")
request.Q = requeststring
Dim Parent = request.Execute()
ParentFolder = (Parent.Items(0).Id)
Catch EX As Exception
MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
End Try
Return ParentFolder
End Function
Drive File Picker Uploader To Upload Files Selected From A File Dialog Box To The Newly Created Folder
Public Sub DriveFilePickerUploader(ByVal ParentFolderID As String)
Try
ProgressBar1.Value = 0
Dim MimeTypeToUse As String
Dim dr As DialogResult = Me.OpenFileDialog1.ShowDialog()
If (dr = System.Windows.Forms.DialogResult.OK) Then
Dim file As String
Else : Exit Sub
End If
Dim i As Integer = 0
For Each file In OpenFileDialog1.FileNames
MimeTypeToUse = GetMimeType(file)
Dim filetitle As String = (OpenFileDialog1.SafeFileNames(i))
Dim body2 = New Google.Apis.Drive.v2.Data.File
body2.Title = filetitle
body2.Description = "J-T Auto File Uploader"
body2.MimeType = MimeTypeToUse
body2.Parents = New List(Of ParentReference)() From {New ParentReference() With {.Id = ParentFolderID}}
Dim byteArray = System.IO.File.ReadAllBytes(file)
Dim stream = New System.IO.MemoryStream(byteArray)
Dim request2 = Service.Files.Insert(body2, stream, MimeTypeToUse)
request2.Upload()
Next
Catch EX As Exception
MsgBox("THERE HAS BEEN AN ERROR" & EX.Message)
End Try
End Sub
Get The Mime Type Of The Files Being Uploaded
Public Shared Function GetMimeType(ByVal file As String) As String
Dim mime As String = Nothing
Dim MaxContent As Integer = CInt(New FileInfo(file).Length)
If MaxContent > 4096 Then
MaxContent = 4096
End If
Dim fs As New FileStream(file, FileMode.Open)
Dim buf(MaxContent) As Byte
fs.Read(buf, 0, MaxContent)
fs.Close()
Dim result As Integer = FindMimeFromData(IntPtr.Zero, file, buf, MaxContent, Nothing, 0, mime, 0)
Return mime
End Function
<DllImport("urlmon.dll", CharSet:=CharSet.Auto)> _
Private Shared Function FindMimeFromData( _
ByVal pBC As IntPtr, _
<MarshalAs(UnmanagedType.LPWStr)> _
ByVal pwzUrl As String, _
<MarshalAs(UnmanagedType.LPArray, ArraySubType:=UnmanagedType.I1, SizeParamIndex:=3)> ByVal _
pBuffer As Byte(), _
ByVal cbSize As Integer, _
<MarshalAs(UnmanagedType.LPWStr)> _
ByVal pwzMimeProposed As String, _
ByVal dwMimeFlags As Integer, _
<MarshalAs(UnmanagedType.LPWStr)> _
ByRef ppwzMimeOut As String, _
ByVal dwReserved As Integer) As Integer
End Function
Hopefully this helps you make a start I am 100% convinced this is achievable as I have already done this for my manager.
This reply might be late but just wanna share one of the approach!
I have done this successfully with VBA and the demo link is here
http://www.sfdp.net/thuthuataccess/demo/democAuth.rar?attredirects=0&d=1
With this, you can upload, download or delete a file with your GoogleDrive in Access..
Just Wininet + WinHTTP enough
Dang Dinh ngoc
Vietnam
I'm trying to get some information from Active Directory with VB.NET.
I have the "primaryGroupID" of a user, which is 2096 in this case.
How can I get, with VB.NET, the CN of this group?
Ultimately, what I need to do is find a list of groups that a user belongs to (including groups that belong to another group). I already have a function that gets the main groups except for the primary group, and another function that returns the ID of the primary group. Both detailed below.
Public Function getUserGroups(ByVal Username)
Dim grupos As New ArrayList()
Try
Dim Entry As New System.DirectoryServices.DirectoryEntry(ldapPath, ldapAdminUser, ldapAdminPass)
Dim Searcher As New System.DirectoryServices.DirectorySearcher(Entry)
Searcher.SearchScope = DirectoryServices.SearchScope.Subtree
Searcher.Filter = "(&(objectcategory=user)(SAMAccountName=" & Username & "))"
Dim res As SearchResult = Searcher.FindOne
For i = 0 To res.Properties("memberOf").Count() - 1
grupos.Add(res.Properties("memberOf")(i).ToString)
Next
Catch ex As Exception
End Try
Return grupos
End Function
Public Function GetUserPrimaryGroupID(ByVal user As String) As String
Dim grupoID As String = ""
Try
Dim Entry As New System.DirectoryServices.DirectoryEntry(ldapPath, ldapAdminUser, ldapAdminPass)
Dim Searcher As New System.DirectoryServices.DirectorySearcher(Entry)
Searcher.SearchScope = DirectoryServices.SearchScope.Subtree
Searcher.Filter = "(&(objectcategory=user)(SAMAccountName=" & user & "))"
Dim res As SearchResult = Searcher.FindOne
For i = 0 To res.Properties("primaryGroupID").Count() - 1
grupoID = (res.Properties("primaryGroupID")(i).ToString) 'Esto devuelve la ruta "CN" del grupo
'grupoID = (res.Properties("primaryGroupID")(i).ToString)
'Dim de As DirectoryEntry = New DirectoryEntry("LDAP://" + res.Properties("primaryGroupID")(i).ToString())
Next
Catch ex As Exception
End Try
Return grupoID
End Function
There's a VBScript sample here - http://support.microsoft.com/kb/297951.
Essentially the primary group ID is the RID (the last component of the SID) of a group. So to find the group, you concatenate the domain SID and the primary group ID together.
How can I determine if a user, in say Access, is a member of an Active Directory Security Group?
I'd rather not build a whole authentication system into my little Access DB.
Thanks
Allain found this online
Function IsMember(strDomain As String, strGroup _
As String, strMember As String) As Boolean
Dim grp As Object
Dim strPath As String
strPath = "WinNT://" & strDomain & "/"
Set grp = GetObject(strPath & strGroup & ",group")
IsMember = grp.IsMember(strPath & strMember)
End Function
You can get the Windows account info by way of the USERDOMAIN and USERNAME environment vars:
Function GetCurrentUser() As String
GetCurrentUser = Environ("USERNAME")
End Function
Function GetCurrentDomain() As String
GetCurrentDomain = Environ("USERDOMAIN")
End Function
Putting it all together:
If IsMember(GetCurrentDomain, "AD Group", GetCurrentUser) Then
DoStuff()
End If
I'm late to the game with this, but the code you need is below. It gets user names and domain names for you.
Note that I'm not using objGroup.Ismember - that's actually the correct method to use - I'm enumerating the list of groups that the user is in, because it's much easier to debug and there's no appreciable performance penalty.
...And I lifted the code from an earlier project, in which I needed to check membership of a 'Read Reports' group, an 'Edit Data' Group, and an 'Edit System Data' group, so that I could choose which controls to enable and which forms to open read-only. Enumerating groups once was faster than three separate checks.
Public Function UserIsInGroup(GroupName As String, _
Optional Username As String, _
Optional Domain As String) As Boolean
'On Error Resume Next
' Returns TRUE if the user is in the named NT Group.
' If user name is omitted, current logged-in user's login name is assumed.
' If domain is omitted, current logged-in user's domain is assumed.
' User name can be submitted in the form 'myDomain/MyName'
' (this will run slightly faster)
' Does not raise errors for unknown user.
'
' Sample Usage: UserIsInGroup( "Domain Users")
Dim strUsername As String
Dim objGroup As Object
Dim objUser As Object
Dim objNetwork As Object
UserIsInGroup = False
If Username = "" Then
Set objNetwork = CreateObject("WScript.Network")
strUsername = objNetwork.UserDomain & "/" & objNetwork.Username
Else
strUsername = Username
End If
strUsername = Replace(strUsername, "\", "/")
If InStr(strUsername, "/") Then
' No action: Domain has already been supplied in the user name
Else
If Domain = "" Then
Set objNetwork = CreateObject("WScript.Network")
Domain = objNetwork.UserDomain
End If
strUsername = Domain & "/" & strUsername
End If
Set objUser = GetObject("WinNT://" & strUsername & ",user")
If objUser Is Nothing Then
' Insert error-handler here if you want to report an unknown user name
Else
For Each objGroup In objUser.Groups
'Debug.Print objGroup.Name
If GroupName = objGroup.Name Then
UserIsInGroup = True
Exit For
End If
Next objGroup
End If
Set objNetwork = Nothing
Set objGroup = Nothing
Set objUser = Nothing
End Function
Hopefully this late submission is of use to other developers: when I looked this up for the first time, back in 2003, it was like nobody had ever used AD groups in Excel or MS-Access.
Found this online
Function IsMember(strDomain As String, strGroup _
As String, strMember As String) As Boolean
Dim grp As Object
Dim strPath As String
strPath = "WinNT://" & strDomain & "/"
Set grp = GetObject(strPath & strGroup & ",group")
IsMember = grp.IsMember(strPath & strMember)
End Function
Now, I only need the account name of the current user. Too bad Application.CurrentUser doesn't give me their Domain Account name.