в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:46:53Z

1 версия

Новая страница

==Add group==



<source lang="vb">

Sub GroupAdd()
Dim mySpace As Workspace
Dim grpRegistrars As Group
Dim strGroupPID As String
Set mySpace = DBEngine(0)
strGroupPID = "5678"
Set grpRegistrars = mySpace.CreateGroup("Registrars")
grpRegistrars.PID = strGroupPID
mySpace.Groups.Append grpRegistrars
End Sub
</source>

==Adding a User to a New Group==



<source lang="vb">

Sub AddUser_ToNewGroup()
Dim cat As ADOX.Catalog
Dim conn As ADODB.Connection
Dim strDB As String
Dim strSysDb As String
Dim strName As String
On Error GoTo ErrorHandle
strDB = CurrentProject.Path & "\mydb.mdb"
strSysDb = CurrentProject.Path & "\mydb.mdw"
strName = "Elite"
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Jet OLEDB:System Database") = strSysDb
.Properties("User ID") = "Developer"
.Properties("Password") = "mypass"
.Open strDB
End With
Set cat = New ADOX.Catalog
With cat
.ActiveConnection = conn
.Groups.Append strName
.Users("PowerUser").Groups.Append strName
End With
ExitHere:
Set cat = Nothing
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandle:
Set cat = Nothing
If Err.Number = -2147467259 Then
MsgBox strName & " account already exists."
Else
MsgBox Err.Description
End If
Resume ExitHere
End Sub
</source>

==Add user to group==



<source lang="vb">

Sub AddUserToGroup()
Dim mySpace As Workspace
Dim usrMark As User
Set mySpace = DBEngine(0)
Set usrMark = mySpace.CreateUser("Mark Fenton")
mySpace.Groups("Registrars").Users.Append usrMark
End Sub
</source>

==Creating a Group Account==



<source lang="vb">

Sub Create_Group()
Dim cat As ADOX.Catalog
Dim conn As ADODB.Connection
Dim strDB As String
Dim strSysDb As String
Dim strName As String
On Error GoTo ErrorHandle
strDB = CurrentProject.Path & "\mydb.mdb"
strSysDb = CurrentProject.Path & "\mydb.mdw"
strName = "Masters"

Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Jet OLEDB:System Database") = strSysDb
.Properties("User ID") = "Developer"
.Properties("Password") = "pass"
.Open strDB
End With
Set cat = New ADOX.Catalog
With cat
.ActiveConnection = conn
.Groups.Append strName
End With
Debug.Print "Successfully created " & strName & " group account."
ExitHere:
Set cat = Nothing
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandle:
If Err.Number = -2147467259 Then
MsgBox strName & " group already exists."
Else
MsgBox Err.Description
End If
End Sub
</source>

==Creating a Group Account with SQL command==



<source lang="vb">

Sub CreateGroupAccount()
Dim conn As ADODB.Connection
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
conn.Execute "CREATE GROUP YourGroupN asdf"
ExitHere:
If Not conn Is Nothing Then
If conn.State = adStateOpen Then conn.Close
End If
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Deleting a Group Account==



<source lang="vb">

Sub Delete_Group()
Dim conn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim strDB As String
Dim strSysDb As String
On Error GoTo ErrorHandle
strDB = CurrentProject.Path & "\mydb.mdb"
strSysDb = CurrentProject.Path & "\mydb.mdw"
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Jet OLEDB:System Database") = strSysDb
.Properties("User ID") = "Developer"
.Properties("Password") = "mypass"
.Open strDB
End With
Set cat = New ADOX.Catalog
With cat
.ActiveConnection = conn
.Groups.Delete "GroupName"
End With
ExitHere:
Set cat = Nothing
conn.Close
Set conn = Nothing
Exit Sub
ErrorHandle:
If Err.Number = 3265 Then
cat.Groups.Append "Masters"
Resume
Else
MsgBox Err.Description
Resume ExitHere
End If
End Sub
</source>

==Deleting a Group Account with SQL command==



<source lang="vb">

Sub DeleteGroupAccount()
Dim conn As ADODB.Connection
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
conn.Execute "DROP GROUP YourGroupName"
ExitHere:
If Not conn Is Nothing Then
If conn.State = adStateOpen Then conn.Close
End If
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Deleting a User Account with SQL command==



<source lang="vb">

Sub DeleteUserAccount()
Dim conn As ADODB.Connection
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
conn.Execute "DROP USER yourName"
ExitHere:
If Not conn Is Nothing Then
If conn.State = adStateOpen Then conn.Close
End If
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Granting Permissions for Tables to an Existing Group with SQL command==



<source lang="vb">

Sub SetTblPermissions()
Dim conn As ADODB.Connection
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
conn.Execute "GRANT SELECT, DELETE, INSERT, " _
& "UPDATE ON CONTAINER TABLES TO yourGroupName"
ExitHere:
If Not conn Is Nothing Then
If conn.State = adStateOpen Then conn.Close
End If
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Listing All Group Accounts==



<source lang="vb">

Sub List_Groups()
Dim conn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim grp As New ADOX.Group
Dim strDB As String
Dim strSysDb As String
strDB = CurrentProject.Path & "\mydb.mdb"
strSysDb = CurrentProject.Path & "\mydb.mdw"
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Jet OLEDB:System Database") = strSysDb
.Properties("User ID") = "Developer"
.Properties("Password") = "mypass"
.Open strDB
End With
Set cat = New ADOX.Catalog
cat.ActiveConnection = conn
For Each grp In cat.Groups
Debug.Print grp.Name
Next
Set cat = Nothing
conn.Close
Set conn = Nothing
End Sub
</source>

==Listing Users in Groups==



<source lang="vb">

Sub List_UsersInGroups()
Dim conn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim grp As New ADOX.Group
Dim myUser As New ADOX.User
Dim strDB As String
Dim strSysDb As String
strDB = CurrentProject.Path & "\mydb.mdb"
strSysDb = CurrentProject.Path & "\mydb.mdw"
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Jet OLEDB:System Database") = strSysDb
.Properties("User ID") = "Developer"
.Properties("Password") = "mypass"
.Open strDB
End With
Set cat = New ADOX.Catalog
cat.ActiveConnection = conn
For Each grp In cat.Groups
Debug.Print "Group Name: " & grp.Name
If cat.Groups(grp.Name).Users.count = 0 Then
Debug.Print "There are no users in the " & grp & " group."
End If
For Each myUser In cat.Groups(grp.Name).Users
Debug.Print "User Name: " & myUser.Name
Next myUser
Next grp
Set cat = Nothing
conn.Close
Set conn = Nothing
End Sub
</source>

==Making a User Account a Member of a Group with SQL command==



<source lang="vb">

Sub AddUserToGroup()
Dim conn As ADODB.Connection
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
conn.Execute "ADD USER YourName TO YourGroupN"
ExitHere:
If Not conn Is Nothing Then
If conn.State = adStateOpen Then conn.Close
End If
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Removing a User Account from a Group with SQL command==



<source lang="vb">

Sub RemoveUserFromGroup()
Dim conn As ADODB.Connection
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
conn.Execute "DROP USER yourName FROM YourGroupName"
ExitHere:
If Not conn Is Nothing Then
If conn.State = adStateOpen Then conn.Close
End If
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==Revoking Security Permissions with SQL command==



<source lang="vb">

Sub RevokePermission()
Dim conn As ADODB.Connection
On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection
conn.Execute "REVOKE DELETE ON CONTAINER TABLES FROM YourGroupName"
ExitHere:
If Not conn Is Nothing Then
If conn.State = adStateOpen Then conn.Close
End If
Set conn = Nothing
Exit Sub
ErrorHandler:
Debug.Print Err.Number & ":" & Err.Description
Resume ExitHere
End Sub
</source>

==To create a new group account in the current database==



<source lang="vb">

Sub Create_Group2()
Dim cat As ADOX.Catalog

On Error GoTo ErrorHandle

Set cat = New ADOX.Catalog
With cat
.ActiveConnection = CurrentProject.Connection
.Groups.Append "Masters"
End With

ExitHere:
Set cat = Nothing
Exit Sub
ErrorHandle:
If Err.Number = -2147467259 Then
MsgBox "This group already exists."
Else
MsgBox Err.Description
End If
Resume ExitHere
End Sub
</source>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Access/Group Account - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия