ExcelBanter - SQL against xldatabase in same worksheet

"cmdecker2" wrote ...

How do I reference an xls database in the same worksheet? I want to create
a dynamic sql that will search the datbase like the dataform tool. The code
will eventully pull some records to a separate worksheet for editing, but I
need to get the record first.

You can access the data in a workbook using ADO but due to the dreaded
memory leak bug, you can't query an open workbook. Happily, the
workaround is easy enough: save a copy of the relevant worksheet(s) to
a temporary (closed) workbook and query the temp workbook.

Here's one I made earlier:

Sub Test()

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

' Amend the following constants to suit
Const FILENAME_XL_TEMP As String = "" & _
"delete_me.xls"
Const TABLE_NAME_CURRENT As String = "" & _
"XXX"
Const TABLE_NAME_NEW As String = "" & _
"MyNewTable"

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

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

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

' Build sql statement
strSql1 = ""
strSql1 = strSql1 & "SELECT * FROM "
strSql1 = strSql1 & " [" & TABLE_NAME_CURRENT & "$]"
' strSql1 = strSql1 & " WHERE nr=1 OR nr=3"

' 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(TABLE_NAME_CURRENT). _
Copy .Worksheets(1)
.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
.Name = TABLE_NAME_NEW
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

End Sub

--