使用Excel-VBA和ADODB对象时出现“自动化错误”“未指定错误”

Question

我正在创建一个宏，该宏可以浏览文件夹，对每个文档执行SQL操作，然后将结果复制到另一个工作簿中；但是，每次调试并击中Set rs = cn.Execute(sql)行时，我都会得到

  

“自动化错误”“未指定错误”。

更奇怪的是，当我运行代码时，我得到了

  

“对象_Connection执行失败”错误。

我已经在Microsoft SQL Server中测试了SQL代码，并且这些语句中的每一个几乎都与我以前可以使用的代码完全相同。

Option Explicit


Sub hardnessTests()

    On Error GoTo ErrorHandling

    Dim filename As Variant, n As Long
    n = 0

    Call turnOff

    filename = Dir("T:\Marketing\Data Analytics\GIS Data\Water Quality Portal Data\County Summary Results\*")

    While filename <> ""

        Dim file As String, cn As Object, rs As Object, sql As String, hardField As ADODB.Field
        file = "T:\Marketing\Data Analytics\GIS Data\Water Quality Portal Data\County Summary Results\" & filename

        Set cn = CreateObject("ADODB.Connection")

        With cn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .connectionstring = "Data Source=" & file & ";Extended Properties=""Excel 12.0 Xml;HDR=YES;Readonly=false;IMEX=0"";"
            .Open
        End With

        sql = "SELECT c.STATEFP, c.COUNTYFP, AVG(CAST(a.ResultMeasureValue AS NUMERIC)) AS Average_Surface_Water_Hardness, COUNT(a.ResultMeasureValue) AS Number_Of_Surface_Water_Tests, " & _
              "AVG(CAST(b.ResultMeasureValue AS NUMERIC)) AS Average_Groundwater_Hardness, COUNT(b.ResultMeasureValue) AS Number_Of_Groundwater_Tests " & _
              "FROM (SELECT * FROM [Sheet1$] WHERE CAST(LEFT(ActivityStartDate, 4) AS NUMERIC) >= 2010 and ActivityMediaSubdivisionName = 'Surface Water') a, " & _
              "(SELECT * FROM [Sheet1$] WHERE CAST(LEFT(ActivityStartDate, 4) AS NUMERIC) >= 2010 AND ActivityMediaSubdivisionName = 'Groundwater') b, " & _
              "(SELECT * FROM [Sheet1$] WHERE CAST(LEFT(ActivityStartDate, 4) AS NUMERIC) >= 2010 ) c GROUP BY c.STATEFP, c.COUNTYFP ORDER BY c.STATEFP, c.COUNTYFP"

        Set rs = cn.Execute(sql)

        Dim wb As Workbook, fieldCount As Long
        fieldCount = 0
        Set wb = Workbooks.Add
        wb.SaveAs "T:\Marketing\Data Analytics\GIS Data\Water Quality Portal Data\County Summary Results\ALL_HARDNESS.xlsx"

        If n = 0 Then
            wb.Worksheets("Sheet1").Range("A2").CopyFromRecordset rs
        Else:
            wb.Worksheets("Sheet1").Range("A2").End(xlDown).CopyFromRecordset rs
        End If

        filename = Dir
        n = n + 1

    Wend

    For Each hardField In rs.Fields
        wb.Worksheets("Sheet1").Range("A1").Offset(0, fieldCount) = hardField.Name
        fieldCount = fieldCount + 1
    Next hardField

    Call turnOn

Exit Sub

ErrorHandling:
    MsgBox ("Source: " & Err.Source & vbNewLine & "Number: " & Err.Number & vbNewLine & "Description: " & Err.Description & vbNewLine & "Help Context: " & Err.HelpContext)
Done:
    End Sub

Private Sub turnOff()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

End Sub

Private Sub turnOn()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = True

End Sub

感谢您的帮助！