我从网上找到以下代码,是为access数据库添加用户的,可是不能用不知道为什么? Private Function AddUser(ByVal strUser As String, _
ByVal strPID As String, _
Optional ByVal strPwd As String) As Boolean
Dim catDB As ADOX.Catalog 
On Error GoTo AddUser_Err
Set catDB = New ADOX.Catalog
With catDB
.ActiveConnection = CurrentProject.Connection
.Users.Append strUser, strPwd, strPID
.Groups("Users").Users.Append strUser
End With
Set catDB = Nothing
AddUser = True
AddUser_Err:
Msgbox Err.Number & ":" & Err.Description
AddUser = False 
End Function我把CurrentProject.Connection改为
"Provider =Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb" & ";"
后.Users.Append strUser, strPwd, strPID这句出错
错误提示为 对象提供者不能执行所需要的操作
请问大家怎么回事

解决方案 »

  1.   

    向 Group 对象的 Users 集合中追加 User 对象之前,Catalog 的 Users 集合中必须已经存在与被追加的对象具有相同 Name 的 User 对象。
      

  2.   

    Option ExplicitDim cn As New ADODB.Connection, rs   As New ADODB.Recordset'保存
    Private Sub Command1_Click()
        Dim bteContent() As Byte
        
        Open "C:\aa.bmp" For Binary Access Read As #1
        bteContent = InputB(LOF(1), #1)
        Close #1
        
        If rs.State = adStateOpen Then rs.Close
        rs.Open "select * from tablename", cn, adOpenDynamic, adLockPessimistic
        rs.AddNew
        rs!Name = "张三"
        rs!AGE = 22
        rs!SEX = "男"
        rs.Fields("PHOTO").AppendChunk bteContent
        rs.Update
        
        Erase bteContent
    End Sub'打开
    Private Sub Command2_Click()
        Dim bteContent() As Byte
        If rs.State = adStateOpen Then rs.Close
        rs.Open "select * from tablename", cn, adOpenForwardOnly, adLockReadOnly
        bteContent = rs.Fields("PHOTO").GetChunk(rs.Fields("PHOTO").ActualSize)    Open "C:\aa.bmp" For Binary Access Write As #1
        Put #1, , bteContent
        Close #1
        Image1.Picture = LoadPicture("C:\aa.bmp")
    End SubPrivate Sub Form_Load()
    On Error GoTo Errhandle
        cn.ConnectionString = "Driver={SQL Server};SERVER=DataServer;DATABASE=zxzx;UID=information;PWD=information*&#"
        cn.Open
        
        Exit Sub
    Errhandle:
        MsgBox Err.Description, vbExclamation
    End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error Resume Next
        rs.Close
        Set rs = Nothing
        cn.Close
        Set cn = Nothing
    End Sub
      

  3.   

    请问 fuanwei(草原上狂奔的蜗牛) 
    我看不太明白
    能不能写出代码??
      

  4.   

    http://access911.net/index.asp?board=4&mode=3&recordid=71FAB51E#odc_acsecurity_add
      

  5.   

    yoki
    就是在这里看的可是不能用,为什么??
      

  6.   

    yoki,那個站長還是什麼人就是access的豬老大,很兇人的說
      

  7.   

    ' BeginGroupVB
    Sub Main()
        On Error GoTo GroupXError    Dim cat As ADOX.Catalog
        Dim usrNew As ADOX.User
        Dim usrLoop As ADOX.User
        Dim grpLoop As ADOX.Group
        
        Set cat = New ADOX.Catalog
        
        cat.ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';" & _
            "Data Source='Northwind.mdb';" & _
            "jet oledb:system database=" & _
            "'system.mdw'"    With cat
            'Create and append new group with a string.
            .Groups.Append "Accounting"
           
            ' Create and append new user with an object.
            Set usrNew = New ADOX.User
            usrNew.Name = "Pat Smith"
            usrNew.ChangePassword "", "Password1"
            .Users.Append usrNew        ' Make the user Pat Smith a member of the
            ' Accounting group by creating and adding the
            ' appropriate Group object to the user's Groups
            ' collection. The same is accomplished if a User
            ' object representing Pat Smith is created and
            ' appended to the Accounting group Users collection
            usrNew.Groups.Append "Accounting"
          
            ' Enumerate all User objects in the
            ' catalog's Users collection.
            For Each usrLoop In .Users
                Debug.Print "  " & usrLoop.Name
                Debug.Print "    Belongs to these groups:"
                ' Enumerate all Group objects in each User
                ' object's Groups collection.
                If usrLoop.Groups.Count <> 0 Then
                    For Each grpLoop In usrLoop.Groups
                        Debug.Print "    " & grpLoop.Name
                    Next grpLoop
                Else
                    Debug.Print "    [None]"
                End If
            Next usrLoop        ' Enumerate all Group objects in the default
            ' workspace's Groups collection.
            For Each grpLoop In .Groups
                Debug.Print "  " & grpLoop.Name
                Debug.Print "    Has as its members:"
                ' Enumerate all User objects in each Group
                ' object's Users collection.
                If grpLoop.Users.Count <> 0 Then
                    For Each usrLoop In grpLoop.Users
                        Debug.Print "    " & usrLoop.Name
                    Next usrLoop
                Else
                    Debug.Print "    [None]"
                End If
            Next grpLoop
            
            ' Delete new User and Group objects because this
            ' is only a demonstration.
            ' These two line are commented out because the sub "OwnersX" uses
            ' the group "Accounting".
    '        .Users.Delete "Pat Smith"
    '        .Groups.Delete "Accounting"    End With    'Clean up
        Set cat.ActiveConnection = Nothing
        Set cat = Nothing
        Set usrNew = Nothing
        Exit Sub
        
    GroupXError:
        
        Set cat = Nothing
        Set usrNew = Nothing
        
        If Err <> 0 Then
            MsgBox Err.Source & "-->" & Err.Description, , "Error"
        End If
    End Sub
    ' EndGroupVB
      

  8.   

    以上是msdn的源码
    为什么还是不能运行呢???
      

  9.   

    跟你的ADO的版本有关。请检查你的版是否支持。
      

  10.   

    ado2.6
    adox2.6
    还不够高吗?
      

  11.   

    哪位试好了把源码发给我,不甚感激
    [email protected]