Access select query results into Excel 2

[richand1]

Hi all.

I have this ADO code to import data from an Access query to Excel:

Sub Test()

Dim db1 As Database
Dim rs1 As Recordset
Dim intColIndex1 As Integer
Dim mydb1 As String

Dim FieldName1 As String
Dim MyCriteria1 As String
Dim TableName1 As String

    
    TableName1 = "tbl_UK_All_Data"

    mydb1 = "P:\Database.mdb"

    Set TargetRange = Range("A1")
    Set db1 = OpenDatabase(mydb1)
    Set rs = db1.OpenRecordset("SELECT * FROM " & TableName)
                           
    For intColIndex1 = 0 To rs.Fields.Count - 1
        TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex1).Name
    Next
    
    TargetRange.Offset(1, 0).CopyFromRecordset rs
    
    Set rs = Nothing
    db1.Close
    Set db1 = Nothing

End Sub

This code works perfectly so no problem there, but this new scenario requires the criteria for the query to be a list of varying length within Excel itself, e.g.

Column1
Criteria1
Criteria2
Criteria3
Etc...
Etc...

So, is it possible to modify my code above to include some script that passes this criteria to the Access query, even if the criteria list will be a different length every time? I want the criteria field in Access to ultimately read:

In("Criteria1", "Criteria2", "Criteria3") etc etc.

Can it be done???!!!

Many thanks people.

R

 

[SkipVought]

Hi,

I wrote this, keep it in my PERSONAL.XLS and use this regularly...

Function MakeList(rng As Range, Optional TK As String = "'", Optional CM As String = ",") As String
'SkipVought/2005 Jun 13
'--------------------------------------------------
' Access: N/A
'--------------------------------------------------
':this function returns a single-quoted list that can be used, for instance _
in an IN Clause in SQL _
"WHERE PART_ID IN (" & MakeList([SomeRange]) & ")"
'--------------------------------------------------
    Dim r As Range
    
    For Each r In rng
        With r
            MakeList = MakeList & TK & Trim(.Value) & TK & CM
        End With
    Next
    MakeList = Left(MakeList, Len(MakeList) - 1)
End Function

Skip,
sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[richand1]

Skip, always the first to reply and the most helpful...

Anyway, I have created a module with your function code in - this seems to work fine - and I have edited my code to include the function call, below and in bold:

Sub Test()

Dim db1 As Database
Dim rs1 As Recordset
Dim intColIndex1 As Integer
Dim mydb1 As String

Dim FieldName1 As String
Dim MyCriteria1 As String
Dim TableName1 As String

    
    TableName1 = "tbl_UK_All_Data"

    mydb1 = "P:\Database.mdb"

    Set TargetRange = Range("A1")
    Set db1 = OpenDatabase(mydb1)
    [b][red]Set rs = db.OpenRecordset("SELECT * FROM " & TableName & "WHERE UNIT_ID IN(" & MakeList([A1:A500]) & ")")[/b][/red]
                           
    For intColIndex1 = 0 To rs.Fields.Count - 1
        TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex1).Name
    Next
    
    TargetRange.Offset(1, 0).CopyFromRecordset rs
    
    Set rs = Nothing
    db1.Close
    Set db1 = Nothing

End Sub

but my code gives me an error:

Run-time error '3131':

Syntax error in FROM clause.

Have you got any ideas?

Thanks again.

R

 

[richand1]

Oh dear, I clicked on the Submit button by accident.

I think you're going to say it has something to do with the way the criteria range is written...

 

[PHV]

Replace this:
"WHERE
with this:
" WHERE

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[richand1]

A SPACE???!!! Oh. My. God. I'm officially an idiot. Skip's given up and gone home ;-)

Thank you both very much. Votes for you both are pending...

R

 

[richand1]

Hi Skip. I hope you're well.

With your "MakeList" function, would you be able to tell me how to alter it to include - in the "SomeRange" reference element - the worksheet name that the criteria range resides in? Do you even think that this is worth it?

Thanks a lot.
Rich

 

[SkipVought]

   Dim sSQL as string
   sSQL = "SELECT *"
   sSQL = sSQL & vbLf
   sSQL = sSQL & "FROM " & TableName"
   sSQL = sSQL & vbLf
   sSQL = "WHERE UNIT_ID IN (" & MakeList([b]Sheets("YourSheetName").[/b][A1:A500]) & ")"

    Set rs = db.OpenRecordset(sSQL)

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[richand1]

Legend.

Thanks Skip.