Question

以前我能够运行一些运行多个SQL查询的VBA，并将结果放在单个Excel工作表的单独列中。有一个参考集到Microsoft ActiveX Data Objects 2.8库（工具，VBE中的参考）。

虽然代码工作正常，但最近我收到如下错误消息 -

运行时错误＆＃39; -2147217913（80040e07）＆＃39; 标准表达式中的数据类型不匹配

这是代码（错误出现在＆＃34; rs.Open sql，cn，adOpenStatic＆＃34;这不太有帮助）。请注意，我尝试运行的所有VBA / SQL代码中都会出现相同的错误，而不仅仅是下面的代码。

Private Sub GetUniqueClassesListWithConditions()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strWkbPath As String
    Dim sql As String
    Dim buf As Variant
    Dim i As Long
    Dim j As Long
    Dim iTimes As Integer
    Dim iQuestion As Integer
    Dim iCondition As Integer
    Dim iLimit As Integer
    Dim sCondition As String
    Dim iColumn As Integer

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    strWkbPath = ThisWorkbook.FullName

    Worksheets.Add After:=Sheets(Sheets.Count)

    For iQuestion = 1 To 14

        For iTimes = 1 To 5

            Select Case iTimes

                Case 1
                iLimit = 7
                sCondition = "Day"

                Case 2
                iLimit = 6
                sCondition = "Time"

                Case 3
                iLimit = 16
                sCondition = "Faculty"

                Case 4
                iLimit = 13
                sCondition = "Department"

                Case 5
                iLimit = 6
                sCondition = "Student Numbers"

            End Select

            For iCondition = 1 To iLimit

                sql = "SELECT DISTINCT([Data$].Class) FROM [Data$] WHERE [Data$].Q" & iQuestion & " <> '-' AND [Data$]." & sCondition & "  = " & iCondition

                j = 0

                Set cn = New ADODB.Connection

                cn.Provider = "Microsoft.ACE.OLEDB.12.0"

                cn.Properties("Extended Properties") = "Excel 12.0;HDR=YES;IMEX=1"

                cn.Open strWkbPath

                Set rs = New ADODB.Recordset

                rs.Open sql, cn, adOpenStatic

                ReDim buf(0 To rs.Fields.Count - 1, 0)

                For i = 0 To rs.Fields.Count - 1

                    buf(i, 0) = rs(i).Name

                Next i

                Do Until rs.EOF

                    j = j + 1

                    ReDim Preserve buf(0 To rs.Fields.Count - 1, 0 To j)

                    For i = 0 To rs.Fields.Count - 1

                        buf(i, j) = rs(i).Value

                    Next i

                    rs.MoveNext

                Loop

                rs.Close

                cn.Close

                Set cn = Nothing

                Set rs = Nothing

                iColumn = iColumn + 1

                With ActiveSheet

                    .Cells(1, iColumn).Value = "Q" & iQuestion & ", " & sCondition & "=" & iCondition

                    .Cells(2, iColumn).Resize(UBound(buf, 2) + 1, UBound(buf, 1) + 1).Value = TransposeArray(buf)

                End With

            Next iCondition

            iColumn = iColumn + 2

        Next iTimes

    Next iQuestion

    With ActiveSheet

        .Rows(1).Font.Bold = True

        .Rows(2).EntireRow.Delete

        .UsedRange.Columns.EntireColumn.AutoFit

        On Error Resume Next

        .Name = "Unique Classes List (Condtions)"

        On Error GoTo 0

    End With

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

End Sub

Private Function TransposeArray(buf)
    Dim tmp()
    Dim i As Long
    Dim j As Long

    ReDim tmp(UBound(buf, 2), UBound(buf, 1))

    For i = LBound(buf, 1) To UBound(buf, 1)

        For j = LBound(buf, 2) To UBound(buf, 2)

            tmp(j, i) = buf(i, j)

        Next j

    Next i

    TransposeArray = tmp

End Function

如果有人可以帮助我运行代码和/或告诉我问题是什么，我将非常感激。

另外，我想在Access中做同样的事情。如果我可以将所有结果导出到Excel文件，即使是工作簿中的不同工作表，我也可以轻松运行其他代码将数据合并到另一个工作表中。（我是Access的新手，知道如何运行SQL，但不知道如何自动化它，包括将结果放在不同的＃34;列＆＃34;并导出它）

应该提及我的SQL＆＃34;技能＆＃34;是基本的，我随身携带学习w3schools（希望我不会在这里冒犯任何人。

提前感谢您的帮助。

SQL查询结果到Excel工作表上的单独列中

0 个答案: