VB code to run a Query in Access and paste results onto an Excelworksheet

[Tony Bender]

I want to create an application where the user makes a selection from
a 'drop-down' in Excel that triggers a Query in Access, copies the
result of the query and pastes it onto a sheet-tab in the Excel
Workbook.

Is this possible?

If so can anyone help me understand the code I would use?

We are XP using Ecel 2003 and Access 2003

Thank you,

Tony

 

[Office_Novice]

Here is the code for the query

Option Explicit
Sub AccessQuery()
Dim DAO As DAO.DBEngine
Dim MyDb12 As DAO.Database
Dim RS_RSQy As DAO.Recordset
Dim i As Variant, x As Long
Dim WS As Worksheet
Dim Count As Integer

Application.ScreenUpdating = False
Set DAO = New DAO.DBEngine
Set MyDb12 = DAO.OpenDatabase("C:\Documents and Settings\Desktop\db12.mdb")
Set RS_RSQy = MyDb12.OpenRecordset("YourRecodset")
Set WS = ActiveWorkbook.Worksheets(2)
Count = RS_PSQC.Fields.Count

For i = 0 To Count - 1
WS.Cells(1, i + 1).Value = RS_RSQy.Fields(i).Name
Next

WS.Range("A2").CopyFromRecordset RS_RSQy

Application.ScreenUpdating = True
Set RS_RSQy = Nothing
Set MyDb12 = Nothing
Set DAO = Nothing
End Sub

 

[Joel]

The easy way of defining the ("YourRecodset") is to manually perform the
query while recording a macro

from worksheet menu
1) Tools - Macro - Record New Macro
2) Data - Import External Data - New Database Query

Set up the Query selecting all your options

3) Tools - Macro - Stop Recording


Modify the recorded macro as necessarry

 

[Tony Bender]

When I try and run the macro here is the error msg I get:

Variable not defined:

Count = RS_PSQC.Fields.Count

Does this mean I need to add this to the other DIM entries? If so how
do I phrase it.

Thank you,

 

[Tony Bender]

Joel,

When I do this which portion is the "RecordSet"?


Here is what I get when I record the macro:

With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User
ID=Admin;Data Source=C:\Data\TripMission 1.mdb;Mode=ReadWrite;Exte" _
, _
"nded Properties="""";Jet OLEDB:System database="""";Jet
OLEDB:Registry Path="""";Jet OLEDBatabase Password="""";Jet
OLEDB:Engine Type=" _
, _
"5;Jet OLEDBatabase Locking Mode=1;Jet OLEDB:Global Partial
Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Datab" _
, _
"ase Password="""";Jet OLEDB:Create System Database=False;Jet
OLEDB:Encrypt Database=False;Jet OLEDBon't Copy Locale on Compact=F"
_
, "alse;Jet OLEDB:Compact Without Replica Repair=False;Jet
OLEDB:SFP=False"), _
Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("qryTRIPGROUP1")
.Name = "TripMission 1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\Data\TripMission 1.mdb"
.Refresh BackgroundQuery:=False
End With

Thank you,

 

[Joel]

I reformated the code. Try this macro and see if it works. I would consider
the Recordset the table you are extracting which is defined by
Array("qryTRIPGROUP1"). technically the recordset should include the file
name. I number of database command I've worked with are SQL. In this case
your are using OLEDB. The code below should be much easier to understand by
putting each command on its own line.

I don't see from these commands why the error Count = RS_PSQC.Fields.Count
is being displayed. Is there more code after the command below?


Sub test()

With ActiveSheet.QueryTables.Add(Connection:=Array( "OLEDB;" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Password="""";" & _
"UserID=Admin;" & _
"Data Source=C:\Data\TripMission 1.mdb;" & _
"Mode=ReadWrite;Extended Properties="""";" & _
"Jet OLEDB:System database="""";" & _
"Jet OLEDB:Registry Path="""";" & _
"Jet OLEDBatabase Password="""";" & _
"Jet OLEDB:Engine Type=5;" & _
"Jet OLEDBatabase Locking Mode=1;" & _
"Jet OLEDB:Global Partial Bulk Ops=2;" & _
"Jet OLEDB:Global Bulk Transactions=1;" & _
"Jet OLEDB:New Database Password="""";" & _
"Jet OLEDB:Create System Database=False;" & _
"Jet OLEDB:Encrypt Database=False;" & _
"Jet OLEDBon't Copy Locale on Compact=False;" & _
"Jet OLEDB:Compact Without Replica Repair=False;" & _
"Jet OLEDB:SFP=False"), _
Destination:=Range("A1"))

.CommandType = xlCmdTable
.CommandText = Array("qryTRIPGROUP1")
.Name = "TripMission 1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\Data\TripMission 1.mdb"
.Refresh BackgroundQuery:=False
End With

End Sub