SQL query results into separate columns on Excel worksheet - sql

Question

Previously I was able to run some VBA that ran several SQL queries and put the results in separate columns in a single Excel worksheet. There was a reference set to Microsoft ActiveX Data Objects 2.8 Library (Tools, References in the VBE).
Although the code was working fine, recently I get an error message as follows -
Run-time error '-2147217913 (80040e07)'
Data type mismatch in criteria expression
Here is the code (the error appears in "rs.Open sql, cn, adOpenStatic" which is less than helpful). Please note that the same error appears in all VBA/SQL code I try to run, not just the code below.
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
If somebody can help me get the code running and/or tell me what the problem is, I'd be very grateful.
Also, I'd like to do the same thing in Access. If I can export all of the results to an Excel file, even as different sheets in a workbook, it's easy for me to run some other code to combine the data into another worksheet. (I'm new to Access and know how to run SQL, but have no idea how to automate it, including putting the results in different "columns" and exporting it)
Should mention my SQL "skills" are basic and I'm learning from w3schools as I go along (hope I'm not offending anybody here.
Thanks for your help in advance.