Sub doSQL()
Dim i As Integer
Dim tim As Long
Dim strCon As String
Dim fldSQL As String
Dim whrSQL As String
Dim oneSQL As String
Dim twoSQL As String
Dim dataSrc As String
' refer to 'microsoft activex data objects library'
' Dim cn As Object
' Dim rs As Object
' Set cn = CreateObject("ADODB.Connection")
' Set rs = CreateObject("ADODB.Recordset")
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
dataSrc = "F:\data.xlsx"
' dataSrc = "F:\data.xlsb"
' dataSrc = "F:\data.xlsm"
dataSrc = ThisWorkbook.FullName
' note: connection string changes for the different filename extensions
' strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & dataSrc & ";" & _
"Extended Properties='Excel 12.0 Macro;HDR=yes;IMEX=0';"
Stop
' note: re. connection strings HDR=yes means that there are headers in worksheet
' if you set HDR=no, then field names are F1, F2 ... and so on
' eg. twoSQL = "SELECT F1, F2, F3 FROM [Sheet1$];"
' ----------------------------------------------------------------------------------
' second fastest 16.8 seconds
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=F:\data.xlsm;" & _
"Extended Properties='Excel 12.0 Macro;HDR=yes;IMEX=0';"
cn.CursorLocation = adUseClient
cn.Open strCon
twoSQL = "SELECT aa FROM [Sheet1$];"
tim = Timer
rs.Open twoSQL, cn
Debug.Print Timer - tim
rs.Close
cn.Close
Stop
' ----------------------------------------------------------------------------------
' fastest 16.3 seconds
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=F:\data.xlsx;" & _
"Extended Properties='Excel 12.0 Xml;HDR=yes;IMEX=0';"
cn.CursorLocation = adUseClient
cn.Open strCon
twoSQL = "SELECT aa FROM [Sheet1$];" ' put column header "aa" in "Sheet1"
tim = Timer
rs.Open twoSQL, cn
Debug.Print Timer - tim
rs.Close
cn.Close
Stop
' ----------------------------------------------------------------------------------
' slow
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=F:\data.xlsb;" & _
"Extended Properties='Excel 12.0;HDR=yes;IMEX=0';"
cn.CursorLocation = adUseClient
cn.Open strCon
twoSQL = "SELECT aa FROM [Sheet1$];" ' put column header "aa" in "Sheet1"
tim = Timer
rs.Open twoSQL, cn
Debug.Print Timer - tim
rs.Close
cn.Close
Stop
' ----------------------------------------------------------------------------------
' works
cn.Provider = "MSDASQL"
cn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & dataSrc & ";" & _
"DSN=myExcelSQL;" & _
"DefaultDir=F:\;" & _
"DriverId=1046;" & _
"FIL=excel 12.0;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5;" & _
""
cn.CursorLocation = adUseClient
cn.Open
twoSQL = "SELECT aa FROM [Sheet1$];" ' put column header "aa" in "Sheet1"
tim = Timer
rs.Open twoSQL, cn
Debug.Print Timer - tim
rs.Close
cn.Close
Stop
' ----------------------------------------------------------------------------------
' xls files only
strCon = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=F:\data.xlsx;" & _
"Extended Properties='Excel 8.0;HDR=yes;IMEX=1';"
cn.CursorLocation = adUseClient
cn.Open strCon
twoSQL = "SELECT aa FROM [Sheet1$];" ' put column header "aa" in "Sheet1"
tim = Timer
rs.Open twoSQL, cn
Debug.Print Timer - tim
rs.Close
cn.Close
Stop
cn.CursorLocation = adUseClient
cn.Open
' twoSQL = "select F1, F2 from [Sheet4$C1:D100] where F1 IN (SELECT F1 FROM [Sheet4$C1:D100] GROUP BY F1 HAVING (Count(1) > 1)); "
' twoSQL = "SELECT F1, count(F1) FROM [Sheet4$C1:D80000] GROUP BY F1 HAVING (Count(1) > 1); "
twoSQL = "SELECT aa FROM [Sheet1$];" ' put column header "aa" in "Sheet1"
' Debug.Print twoSQL & vbCrLf
rs.Open twoSQL, cn
' Debug.Print rs.GetString: rs.MoveFirst
' For i = 0 To rs.Fields.Count - 1
' Debug.Print i & vbTab & rs.Fields(i).name
' Next i
Sheets("Sheet4").Range("G:H").Clear
' Sheets("Sheet4").Range("G1").CopyFromRecordset rs
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
