我从网上找到以下代码,是为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这句出错
错误提示为 对象提供者不能执行所需要的操作
请问大家怎么回事
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这句出错
错误提示为 对象提供者不能执行所需要的操作
请问大家怎么回事
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
我看不太明白
能不能写出代码??
就是在这里看的可是不能用,为什么??
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
为什么还是不能运行呢???
adox2.6
还不够高吗?
[email protected]