运行时错误'3706'：找不到提供程序- Excel VBA "Provider=Microsoft.Jet.OLEDB.4.0“
运行时错误'3706'：找不到提供程序- Excel VBA "Provider=Microsoft.Jet.OLEDB.4.0“
提问于 2020-04-09 18:16:03
我发现这个错误并不新鲜，但我找不到解决方案。
我有一个xls文件，它使用一个工作表，比如as db，使用ADODB我可以获得所需的记录集。
代码非常简单，适用于我测试的每台pc(5)，使用WIN7、WIN10、32位或64位。
但是我在PC上，这是客户PC，这让我得到这个错误：Run time error '3706': Provider cannot be found，我已经检查了WIN版本，办公版本，它们和其他PC一样，WIN10 64位，MS Office32位
要解决这个问题，我还需要做更多的控制？！？！谢谢你的建议，fabrizio
我的xls文件有两个工作表，第一个名为"dati“，有两列(Anno，Pezzi)，第二个名为"test”为空，代码如下：
Sub testConn()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strsql As String
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rs = New ADODB.Recordset
#If Win64 Then
cn.Open "Provider=Microsoft.Jet.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"
#Else
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"
#End If
strsql = "SELECT anno, Sum(Pezzi)as Tpz from [dati$] group by anno"
rs.Open strsql, cn, adOpenStatic, adLockReadOnly, adCmdUnspecified
rs.MoveFirst
With Worksheets("test")
.Cells.ClearContents
.Range("A1") = "Anno"
.Range("B1") = "T.Pz"
.Range("A2").CopyFromRecordset rs
.Activate
.Select
End With
End Sub这些引用已添加到文件中：
Microsoft ActiveX Data Objects 6.1 Library
Microsoft ActiveX Data Recordset 2.8 Library回答 1
Stack Overflow用户
回答已采纳
发布于 2020-04-09 20:29:31
这行得通，有一些小细节你用不上。版本12，驱动程序是ace not jet，扩展属性也是Excel 12.0
并且不需要添加库。
Sub testConn()
Dim cn As Object
Dim rs As Object
Dim strsql As String
Dim connString
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
If Application.Version < 12 Then
connString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"
Else
connString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 12.0;HDR=Yes;"";"
End If
cn.Open connString
strsql = "SELECT anno, Sum(Pezzi) as Tpz from [dati$] group by anno"
Set rs = cn.Execute(strsql)
With Worksheets("test")
.Cells.ClearContents
.Range("A1") = "Anno"
.Range("B1") = "T.Pz"
.Range("A2").CopyFromRecordset rs
.Activate
.Select
End With
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/61118879
复制相关文章
相似问题
腾讯云开发者
