时间戳

首页 > 解决方案 > 运行时错误“3706”：找不到提供程序 - Excel VBA“Provider=Microsoft.Jet.OLEDB.4.0”

excel - 运行时错误“3706”：找不到提供程序 - Excel VBA“Provider=Microsoft.Jet.OLEDB.4.0”

问题描述

我看到这个错误并不新鲜，但我找不到解决方案。

我有一个 xls 文件，它使用一张像 db 这样的工作表，使用 ADODB 我得到了我需要的记录集。

代码非常简单，适用于我测试的每台 pc(5)，使用 WIN7、WIN10、32 或 64 位。

但是我在PC上，是客户PC，给我这个错误：Run time error '3706': Provider cannot be found，我检查了WIN版本，Office版本，它们和其他PC一样，WIN10 64位，MS Office 32Bit

为了解决这个问题，我需要做更多的控制？！？！感谢您的任何建议法布里齐奥

我的 xls 文件有 2 张，第 1 张名为“dati”，有两列（Anno，Pezzi），第 2 张名为“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

标签： excelvbaadodboledbconnection

解决方案

这行得通，有一些你使用的小细节不适合。版本 12，驱动程序是 ace 而不是 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

推荐阅读