[已解决]用ADODB链接带密码的ACCESS

zixiaoruixue

请问如何用ADODB链接带密码的ACCESS文件啊？
下面是我现有的代码，但我不知道我的ACCESS文件加密后，怎么修改我的代码啊，有哪位前辈可以帮忙看看嘛？



Private Sub CommandButton1_Click()
Dim Serial$, Rst As New ADODB.Recordset, Strsql$, Ctl As Control, i%

On Error GoTo ErrLine
If Len(TextBox1) = 0 Then
    MsgBox "Pls input serial number", 1 + 16, "alert"
    TextBox1.SetFocus
    Exit Sub
End If

If Condb("TargetDatabase.accdb") = False Then GoTo Line1
Strsql = "select distinct ACCTNO,CUSTNM,Status from [Table] where SerialNum='" & _
    TextBox1 & "' order by  ACCTNO"
Set Rst = cnn.Execute(Strsql)
... ...

Public Function Condb(dbName$) As Boolean
On Error GoTo Line1
    Condb = True
    Set cnn = New ADODB.Connection
    cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
   "Data Source=" & ThisWorkbook.Path & "\" & dbName
    cnn.CursorLocation = adUseClient
    cnn.ConnectionTimeout = 5
    cnn.Open
Exit Function
Line1:
Condb = False
MsgBox "database connection error：" & Chr(10) & Err.Description
End Function

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-3-15 08:28

1. Private Sub CommandButton1_Click()
   
2.     Dim Serial$, Rst As New ADODB.Recordset, Strsql$, Ctl As Control, i%
   
3. 
   
4.     On Error GoTo ErrLine
   
5.     If Len(TextBox1) = 0 Then
   
6.         MsgBox "Pls input serial number", 1 + 16, "alert"
   
7.         TextBox1.SetFocus
   
8.         Exit Sub
   
9.     End If
   
10. 
    
11.     If Condb("TargetDatabase.accdb") = False Then GoTo Line1
    
12.     Strsql = "select distinct ACCTNO,CUSTNM,Status from [Table] where SerialNum='" & _
    
13.              TextBox1 & "' order by  ACCTNO"
    
14.     Set Rst = cnn.Execute(Strsql)
    
15.     ... ...
    
16. 
    
17. Public Function Condb(dbName$, Optional pwd$ = "") As Boolean
    
18.     On Error GoTo Line1
    
19.     Condb = True
    
20.     Set cnn = New ADODB.Connection
    
21.     cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    
22.                            "Data Source=" & ThisWorkbook.Path & "" & dbName & _
    
23.                            ";Jet OLEDB:Database Password=" & pwd & ";"
    
24.     cnn.CursorLocation = adUseClient
    
25.     cnn.ConnectionTimeout = 5
    
26.     cnn.Open
    
27.     Exit Function
    
28. Line1:
    
29.     Condb = False
    
30.     MsgBox "database connection error：" & Chr(10) & Err.Description
    
31. End Function
    

复制代码

改了函数声明，这样在调用的时候，第2个参数是可选的，有密码的就输入密码，没有密码的话第2个参数就不用写。

跳转到最佳答案楼层

hwc2ycy

只要修改连接字符串就可以了。

hwc2ycy

Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\myFolder\myAccessFile.accdb;
Jet OLEDB:Database Password=MyDbPassword;
这是个范例。

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim Serial$, Rst As New ADODB.Recordset, Strsql$, Ctl As Control, i%
   
3. 
   
4.     On Error GoTo ErrLine
   
5.     If Len(TextBox1) = 0 Then
   
6.         MsgBox "Pls input serial number", 1 + 16, "alert"
   
7.         TextBox1.SetFocus
   
8.         Exit Sub
   
9.     End If
   
10. 
    
11.     If Condb("TargetDatabase.accdb") = False Then GoTo Line1
    
12.     Strsql = "select distinct ACCTNO,CUSTNM,Status from [Table] where SerialNum='" & _
    
13.              TextBox1 & "' order by  ACCTNO"
    
14.     Set Rst = cnn.Execute(Strsql)
    
15.     ... ...
    
16. 
    
17. Public Function Condb(dbName$, Optional pwd$ = "") As Boolean
    
18.     On Error GoTo Line1
    
19.     Condb = True
    
20.     Set cnn = New ADODB.Connection
    
21.     cnn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    
22.                            "Data Source=" & ThisWorkbook.Path & "" & dbName & _
    
23.                            ";Jet OLEDB:Database Password=" & pwd & ";"
    
24.     cnn.CursorLocation = adUseClient
    
25.     cnn.ConnectionTimeout = 5
    
26.     cnn.Open
    
27.     Exit Function
    
28. Line1:
    
29.     Condb = False
    
30.     MsgBox "database connection error：" & Chr(10) & Err.Description
    
31. End Function
    

复制代码

改了函数声明，这样在调用的时候，第2个参数是可选的，有密码的就输入密码，没有密码的话第2个参数就不用写。

hwc2ycy

后面的省略的代码你得自己加，别忘了END SUB还有LINE1标签处的错误处理代码。

hwc2ycy

对于2010-2013的格式，请使用旧版加密数据，否则密码正确也无济于事。

hwc2ycy

另外建议楼主在condb里的第一个参数传递完整的路径，这样函数比较通用。