How to run the SQL statement in Excel VBA
 

I have a SQL statement like
"Select * from sheet1 where name=John" to extract the data in sheet1 in a
workbook to another new sheet in the current workbook or a new workbooks,
how can I run this SQL in the VBA

Thanks

How to run the SQL statement in Excel VBA
 

new.microsoft.com wrote:
I have a SQL statement like
"Select * from sheet1 where name=John" to extract the data in sheet1
in a
workbook to another new sheet in the current workbook or a new
workbooks,
how can I run this SQL in the VBA

Querying an open workbook is not recommended e.g. due to a bug in ADO:

http://support.microsoft.com/default...;en-us;Q319998

Note that in the article, Method 1 still creates a memory leak,
therefore we must use automation to copy the required sheet(s) to a
temporary workbook, close it and query the (closed) copy. Here's some
code for which I've tweaked the embedded SQL for you:

Sub test()
CopyToNewWorksheet "Sheet1", "Sheet2"
End Sub

Private Function CopyToNewWorksheet( _
ByVal SheetName As String, _
Optional ByVal NewSheetName As String _
) As Boolean

Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Target As Excel.Range
Dim Con As Object
Dim rs As Object
Dim strCon As String
Dim strPath As String
Dim strSql1 As String
Dim lngCounter As Long

' Review the following constant:
Const FILENAME_XL_TEMP As String = "" & _
"delete_me.xls"

Const TABLE_XL_TEMP As String = "" & _
"test_only"

' Do NOT amend the following constants
Const CONN_STRING As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<PATH<FILENAME;" & _
"Extended Properties='Excel 8.0;HDR=YES'"

Const SQL As String = "" & _
"SELECT * FROM [<SHEET_NAME$] WHERE [name] = 'John';"

' Build connection string
strPath = ThisWorkbook.Path & _
Application.PathSeparator

strCon = CONN_STRING
strCon = Replace(strCon, _
"<PATH", strPath)
strCon = Replace(strCon, _
"<FILENAME", FILENAME_XL_TEMP)

' Build sql statement
strSql1 = SQL
strSql1 = Replace(strSql1, _
"<SHEET_NAME", TABLE_XL_TEMP)

' Delete old instance of temp workbook
On Error Resume Next
Kill strPath & FILENAME_XL_TEMP
On Error GoTo 0

' Save copy of worksheet to temp workbook
Set wb = Excel.Application.Workbooks.Add()
With wb
ThisWorkbook.Worksheets(SheetName). _
Copy .Worksheets(1)
.Worksheets(1).Name = TABLE_XL_TEMP
.SaveAs strPath & FILENAME_XL_TEMP
.Close
End With

' Open connection to temp workbook
Set Con = CreateObject("ADODB.Connection")
With Con
.ConnectionString = strCon
.Open

Set rs = .Execute(strSql1)
End With

Set ws = ThisWorkbook.Worksheets.Add
With ws
If Len(NewSheetName) 0 Then
.Name = NewSheetName
End If
Set Target = .Range("A1")
End With

With rs
For lngCounter = 1 To .fields.Count
Target(1, lngCounter).Value = _
.fields(lngCounter - 1).Name
Next
End With

Target(2, 1).CopyFromRecordset rs

Con.Close

CopyToNewWorksheet = True

End Function


Jamie.

--