VBA SQL连接带有密码的excel表

betar

如题，如何使用Excel VBA SQL 连接带有密码的Excel表格？假设路径指向的工作表带有密码，为123如附件所示。如何用SQL进行连接？求大神指导。

1. cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;extended properties=Excel 12.0;Data Source=" & Path
   
2.     SQL = "select [Loan Acccout No#] from [Sheet1$A1:DH1048576] "
   

复制代码

test.zip (8.15 KB, 下载次数: 41)

2016-10-18 15:48 上传

点击文件名下载附件

感谢大神回复，现在确定的是无法直接用SQL对带有密码的工作簿进行连接。但是还有一种思路是先用workbooks.open把目标工作簿打开，再对已经打开的工作簿进行连接。可惜个人水平有限，代码会报错，还请各路大神不吝赐教。

1. Sub test()
   
2.     Dim File As Workbook
   
3.     Dim Index As Worksheet
   
4.     Dim cnn
   
5.     Dim rst
   
6.     Dim SQL$
   
7.     Dim Path, Text1, SheetName As String
   
8.    
   
9.     Path = ThisWorkbook.Path & ""
   
10.     Text1 = "test.xlsx"
    
11.     SheetName = "Sheet1"
    
12.    
    
13.     Set ExcelApp = CreateObject("Excel.Application")
    
14.     Set File = ExcelApp.Workbooks.Open(Filename:=Path & Text1, Password:="123")
    
15.     Set Index = File.Worksheets(SheetName)
    
16.    
    
17.     Sheets("Sheet1").Range("a2:e65536").ClearContents
    
18.     Sheets("Sheet1").Select
    
19.    
    
20.     Set cnn = CreateObject("adodb.connection")  'Create DB Connection
    
21.     Set rst = CreateObject("adodb.recordset")
    
22.     cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;extended properties=Excel 12.0;Data Source=" & Path & Text1
    
23.     SQL = "select [Loan No#] from [" & SheetName & "$A1:DH1048576]"
    
24.     Set rst = cnn.Execute(SQL)
    
25.     Worksheets("Sheet1").Range("a" & Range("A65536").End(xlUp).Row + 1).CopyFromRecordset rst
    
26.    
    
27.     rst.Close
    
28.     cnn.Close     'Close SQL Connection
    
29.     Set rst = Nothing
    
30.     Set cnn = Nothing    'Clean SQL from RAM
    
31.    
    
32.     File.Close True
    
33.     Set ExcelApp = Nothing
    
34.     Set File = Nothing
    
35.       
    
36. End Sub
    

复制代码

问题已经由大神microyip解决，详见楼下代码。目前该方法适用于行数小于等于65536的xls, xlsx工作表，对于超出65536行的表格，超过部分不会被连接。

microyip

1. Sub test()
   
2.     Dim File As Workbook
   
3.     Dim cnn
   
4.     Dim SQL$
   
5.     Dim Path, Text1, SheetName As String
   
6.    
   
7.    
   
8.     Path = ThisWorkbook.Path & ""
   
9.     Text1 = "test.xlsx"
   
10.     SheetName = "Sheet1"
    
11.    
    
12.    
    
13.     With Sheets("Sheet1")
    
14.         .[A:E].ClearContents
    
15.    
    
16.         Set File = Workbooks.Open(Filename:=Path & Text1, Password:="123")
    
17.         
    
18.         Set cnn = CreateObject("adodb.connection")  'Create DB Connection
    
19.         cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;extended properties=Excel 12.0;Data Source=" & Path & Text1
    
20.         
    
21.         SQL = "select [Loan No#] from [" & SheetName & "$A:DH]"
    
22.         .[A65536].End(xlUp).Offset(1, 0).CopyFromRecordset cnn.Execute(SQL)
    
23.    
    
24.         cnn.Close     'Close SQL Connection
    
25.         Set cnn = Nothing    'Clean SQL from RAM
    
26.    
    
27.         File.Close True
    
28.     End With
    
29. End Sub

复制代码

jokklx

不行，这种情况下，SQL不能连接，用getobject都不行，只能用workbooks.open打开

microyip

这个还真没想过，好像还真没见过相关资料。关注

fxl447098457

EXCEL 2010 SQL 完全应用里提到,对于设置有密码保护的Excel工作簿,ADO无法打开,只有当工作簿已打开时，ADO才能正常连接。

zhaogang1960

下面网站讲述：

https://www.connectionstrings.com/excel/

If the Excel workbook is protected by a password, you cannot open it for data access, even by supplying the correct password with your connection string. If you try, you receive the following error message: "Could not decrypt file."


如果您的工作簿是由密码保护的，则无法打开数据访问，即使通过提供正确的连接字符串的密码。如果您尝试，您收到以下错误信息：“无法解密文件。”

betar

jokklx 发表于 2016-10-18 17:31
不行，这种情况下，SQL不能连接，用getobject都不行，只能用workbooks.open打开

感谢回复，那么如果excel表格已经用workbooks.open打开了，还可以用SQL进行连接么？

microyip

betar 发表于 2016-10-19 14:16
感谢回复，那么如果excel表格已经用workbooks.open打开了，还可以用SQL进行连接么？

可以用SQL语句对已经打开的工作簿进行访问的

betar

microyip 发表于 2016-10-19 14:45
可以用SQL语句对已经打开的工作簿进行访问的

感谢大神，请问如何连接已经打开的工作簿？假设工作簿名字为“test.xlsx”，工作表名字为“abc”?

microyip

一样是使用原来的语句啊

betar

microyip 发表于 2016-10-19 15:18
一样是使用原来的语句啊

因为我代码所在的工作簿与目标工作簿不是同一个，所以我在用workbook.open打开目标工作簿后，再用与之前相同的代码进行连接，会提示找不到[Sheet1$A1:DH1048576]

1. Sub test()
   
2.     Dim File As Workbook
   
3.     Dim Index As Worksheet
   
4.     Dim cnn
   
5.     Dim rst
   
6.     Dim SQL$
   
7.     Dim Path, Text1, SheetName As String
   
8.    
   
9.     Path = ThisWorkbook.Path & ""
   
10.     Text1 = "test.xlsx"
    
11.     SheetName = "Sheet1"
    
12.    
    
13.     Set ExcelApp = CreateObject("Excel.Application")
    
14.     Set File = ExcelApp.Workbooks.Open(Filename:=Path & Text1, Password:="123")
    
15.     Set Index = File.Worksheets(SheetName)
    
16.    
    
17.     Sheets("Sheet1").Range("a2:e65536").ClearContents
    
18.     Sheets("Sheet1").Select
    
19.    
    
20.     Set cnn = CreateObject("adodb.connection")  'Create DB Connection
    
21.     Set rst = CreateObject("adodb.recordset")
    
22.     cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;extended properties=Excel 12.0;Data Source=" & Path & Text1
    
23.     SQL = "select [Loan No#] from [" & SheetName & "$A1:DH1048576]"
    
24.     Set rst = cnn.Execute(SQL)
    
25.     Worksheets("Sheet1").Range("a" & Range("A65536").End(xlUp).Row + 1).CopyFromRecordset rst
    
26.    
    
27.     rst.Close
    
28.     cnn.Close     'Close SQL Connection
    
29.     Set rst = Nothing
    
30.     Set cnn = Nothing    'Clean SQL from RAM
    
31.    
    
32.     File.Close True
    
33.     Set ExcelApp = Nothing
    
34.     Set File = Nothing
    
35.       
    
36. End Sub
    

复制代码