No trouble. Note the post of urkec. So, we overlooked something simple and
you can run it with late binding no trouble.
As you may need the fields as well I have worked this out a bit further:
Sub test()
Dim i As Long
Dim arr
arr = QueryWorksheet("C:\test.xls", _
"select * from [Sheet1$]", _
Cells(2, 1))
For i = 1 To UBound(arr)
Cells(i) = arr(i)
Next i
End Sub
Function QueryWorksheet(strFile As String, _
strSQL As String, _
rngTarget As Range, _
Optional bClearSheet As Boolean = True, _
Optional bHeader As Boolean = True, _
Optional bFields As Boolean = True) As Variant
Dim i As Long
Dim oADOConn As Object
Dim oADORS As Object
Dim oADOField As Object
Dim strConnect As String
Dim strHeader As String
Dim arr
10 On Error GoTo ERROROUT
20 Set oADOConn = CreateObject("ADODB.Connection")
30 Set oADORS = CreateObject("ADODB.Recordset")
40 If bFields Then
50 bHeader = True
60 End If
70 If bHeader Then
80 strHeader = "HDR=Yes';"
90 Else
100 strHeader = "HDR=No';"
110 End If
'connection string
120 strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFile & ";" & _
"Extended Properties='Excel 8.0;" & strHeader
'open the connection
130 oADOConn.Open strConnect
'Query based on the worksheet name.
'strSQL = "SELECT * FROM [MyXLS_DataSource_file$]"
'Query based on a sheet-level range name.
'strSQL = "SELECT * FROM [MyXLS_DataSource_file$MySheetLevelName]"
'Query based on a specific range address.
'strSQL = "SELECT * FROM [MyXLS_DataSource_file$Sheet3!A10:F16]"
'Query based on a book-level range name.
'strSQL = "SELECT * FROM ????????[MyXLS_DataSource_file$]"
'open the recordset
140 oADORS.Open strSQL, oADOConn, 0, 1
'Check to make sure we received data.
150 If oADORS.EOF Then
160 MsgBox "No Records Returned", , "ADO on workbook " & strFile
170 Else
180 If bClearSheet Then
190 Sheet1.Cells.Clear
200 End If
210 rngTarget.CopyFromRecordset oADORS
220 End If
'get the fields
230 If bFields Then
240 ReDim arr(1 To oADORS.fields.Count) As String
250 For Each oADOField In oADORS.fields
260 i = i + 1
270 arr(i) = oADOField.Name
280 Next
290 End If
'Clean up our objects
300 oADORS.Close
310 Set oADORS = Nothing
320 oADOConn.Close
330 Set oADOConn = Nothing
340 QueryWorksheet = arr
350 Exit Function
ERROROUT:
360 MsgBox Err.Description & vbCrLf & vbCrLf & _
"Error number: " & Err.Number & vbCrLf & vbCrLf & _
"Error line: " & Erl, , "error running ADO on " & strFile
End Function
RBS
JMay said:
RB,
I got it !!!
Thank you, Thank you,
Thank you, Thank you,
This is a new level (of excel) for me;
No turning back now,,
Appreciate your patience.
Jim May
RB Smissaert said:
It will all be the same except the Dim and Set lines.
They will go back to as in the book example.
You can leave the constants as they are or go back
to the ADO ad constants.
I am sure somebody will tell though what the trouble
is with the Late binding code.
RBS
JMay said:
Originally I set out to set up the reference
Tools,
Reference,
Checking ADO 2.8 Library
but wasn't successful - saw Bob's comment abound
Late binding - so I changed directions...
I can change to Early B..
How would I change back the code to accept?
Appreciate your help..
Jim
Yes, I tested and noticed the same.
Not sure now what the trouble is.
Any particular reason why you don't want to set the ADO reference?
Using early binding will be faster and easier.
RBS
Still getting at line:
adoRS.Open szSQL, adoCN, 0, 1
R/T error - 3709 -- The connection cannot be used to perform this
operation. It is
either closed or invalid in this context.
Code to date: (with your suggestions)
Option Explicit
Public Sub QueryWorksheet()
Dim adoCN As Object
Dim adoRS As Object
Dim szConnect As String
Dim szSQL As String
Dim strFile As String
strFile = "C:\Documents and Settings\Jim May\My Documents\" & _
"MyExcelFormulas\My-ADO_Plan\MyXLS_DataSource_file.xls"
Set adoCN = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
'Create the connection string
adoCN = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFile & ";" & _
"Extended Properties='Excel 8.0;HDR=No';"
' Query based on the worksheet name.
'szSQL = "SELECT * FROM [MyXLS_DataSource_file$]"
' Query based on a sheet-level range name.
'szSQL = "SELECT * FROM [MyXLS_DataSource_file$MySheetLevelName]"
' Query based on a specific range address.
'szSQL = "SELECT * FROM [MyXLS_DataSource_file$Sheet3!A10:F16]"
' Query based on a book-level range name.
'szSQL = "SELECT * FROM ????????[MyXLS_DataSource_file$]"
szSQL = "SELECT * FROM [MyXLS_DataSource_file$]"
adoRS.Open szSQL, adoCN, 0, 1
' Check to make sure we received data.
If Not adoRS.EOF Then
Sheet1.Range("A1").CopyFromRecordset adoRS
Else
MsgBox "No Records Returned.", vbCritical
End If
' Clean up our Recordset object
adoRS.Close
Set adoRS = Nothing
End Sub
:
You will need something like this (not tested)
Dim adoCN As Object
Dim adoRS As Object
Dim szConnect As String
Dim szSQL As String
Dim strFile As String
strFile = "C:\Documents and Settings\Jim May\My Documents\" & _
"MyExcelFormulas\My-ADO_Plan\MyXLS_DataSource_file.xls"
Set adoCN = CreateObject("ADODB.Connection")
Set adoRS = CreateObject("ADODB.Recordset")
'Create the connection string
adoCN = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFile & ";" & _
"Extended Properties='Excel 8.0;HDR=No';"
' Query based on the worksheet name.
'szSQL = "SELECT * FROM [MyXLS_DataSource_file$]"
' Query based on a sheet-level range name.
'szSQL = "SELECT * FROM
[MyXLS_DataSource_file$MySheetLevelName]"
' Query based on a specific range address.
'szSQL = "SELECT * FROM [MyXLS_DataSource_file$Sheet3!A10:F16]"
' Query based on a book-level range name.
'szSQL = "SELECT * FROM ????????[MyXLS_DataSource_file$]"
szSQL = "SELECT * FROM [MyXLS_DataSource_file$]"
adoRS.Open szSQL, adoCN, 0, 1
Note that you can't use the ADO constants like adOpenForwardOnly if
there
is
no reference to ADO.
So you have to replace them with the literal values, as above. You
can
get
these values by setting the ADO reference under
Tools, References and then do for example
Msgbox adOpenForwardOnly
and run that.
You can then remove the reference again.
RBS
User-defined type not defined is actually what I get
at the line Set rsdata = New adoRS - after doing a Debug Compile
VBProject
:
Thanks RB, I did as you instructed.
First when I reran code - I got:
Set rsdata = adoRS
Set rsdata 'ERROR Variable not defined, or the like.
so I changed the line to
Set rsdata = New adoRS ' which the book showed before and I
removed
it
'But still it errored @ the New adoRS stage..
Thanks for your help.
:
Before anything else put Option Explicit a the top of that
module
and
then
do Debug, Compile VBAProject.
You will then see that it can't compile, so it can't run.
Get it to compile first and take it from there.
RBS
I'm trying to implement the example of "Querying MS Excel
Workbooks,
Page 411-412 of WROX's EXCEL 2002 VBA Programmer's
Reference.
I use xl 2003 SP2
I entered the original Code below but have (at this point
butchered
it a
bit
- by
commenting out certain lines - Since I found googling a few
lines
suggested
by Bob Phillips regarding Late Binding) - Currently The Code
is
BOMBING at
the Line marked *****
and I am getting the error:
3709 -- The connection cannot be used to perform this
operation.
It
is
either closed or invalid in this context.
Thanks in advance for any help.
Public Sub QueryWorksheet()
'Dim rsdata As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim adoRS As Object, adoCN As Object
Set adoRS = VBA.CreateObject("adodb.recordset")
Set adoCN = VBA.CreateObject("adodb.connection")
'Create the connection string
adoCN = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Documents and Settings\Jim May\My
Documents\MyExcelFormulas\My-ADO_Plan\MyXLS_DataSource_file.xls;"
& _
"Extended Properties='Excel 11.0;HDR=No';"
' Query based on the worksheet name.
'szSQL = "SELECT * FROM [MyXLS_DataSource_file$]"
' Query based on a sheet-level range name.
'szSQL = "SELECT * FROM
[MyXLS_DataSource_file$MySheetLevelName]"
' Query based on a specific range address.
'szSQL = "SELECT * FROM
[MyXLS_DataSource_file$Sheet3!A10:F16]"
' Query based on a book-level range name.
'szSQL = "SELECT * FROM ????????[MyXLS_DataSource_file$]"
szSQL = "SELECT * FROM [MyXLS_DataSource_file$]"
Set rsdata = adoRS
rsdata.Open szSQL, adoCN, adOpenForwardOnly, _ ******
adLockReadOnly
' Check to make sure we received data.
If Not rsdata.EOF Then
Sheet1.Range("A1").CopyFromRecordset
rsdata
Else
MsgBox "No Records Returned.", vbCritical
End If
' Clean up our Recordset object
rsdata.Close
Set rsdata = Nothing
End Sub
