Running an Access query from Excel

[austin1539]

I am trying to run an Access query from Excel. The query, called "ProdActs1" works in Access and is run from using information from a table called "Queries". When a button is clicked in Excel, data currently in the table is deleted and new data is sent based on cell value on the Excel worksheet. So far, I can delete the old records and add new data. I just cannot seem to return results from the query "ProdActs1". Also, is it possible to specify a range to return the query results? Below is the relevant code that I have so far.

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

'If database hasn't been opened yet, user is prompted to choose database
If file = "" Then 'file is a Global String
file = Application.GetOpenFilename
If WB1 = "False" Then Exit Sub
End If


Set cn = New ADODB.Connection 'Opens database connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & file

Set rs = New ADODB.Recordset ' open a recordset
rs.Open "Queries", cn, adOpenKeyset, adLockOptimistic, adCmdTable

' all records in a table


With rs
.Delete ' deletes old records
End With

With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("AssocId") = ActiveSheet.Cells(4, 2).Value
.Fields("Start") = ActiveSheet.Cells(1, 2).Value
.Fields("Principle") = ActiveSheet.Cells(6, 2).Value
.Fields("Activity") = ActiveSheet.Cells(7, 2).Value
.Fields("End") = ActiveSheet.Cells(2, 2).Value
' add more fields if necessary...
.Update ' stores the new record
End With


Thanks in advance.

[Denburt]

Select the location where you want to display the results, select Data then import external data, then Import Data. Once the results are there you can requery it at anytime.

ActiveWorkbook.Sheets("Sheet1").Select
Range("A1").Select
Selection.QueryTable.Refresh BackgroundQuery:=True

Does this help?

[austin1539]

Unfortunately not. I need to automate this process. There are several buttons on a page. If I can get this working, each will pull several queries and perform some formatting on the worksheet and some calculations depending on the button pressed. In addition, once I try this, is causing errors if I try to connect to the DB again. In order to send more data, I have to close out the spreadsheet and reopen it.

Select the location where you want to display the results, select Data then import external data, then Import Data. Once the results are there you can requery it at anytime.

ActiveWorkbook.Sheets("Sheet1").Select
Range("A1").Select
Selection.QueryTable.Refresh BackgroundQuery:=True

Does this help?

[Denburt]

O.K. Change the bold sections and this should get you started. :)

'
' Macro1 Macro
' Macro recorded 3/23/2007 by denburt
'
 
'
    With ActiveSheet.QueryTables.Add(Connection:=Array( _
        "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=YourFullDataBasePathHere;Mode=Share Deny Writ" _
        , _
        "e;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine" _
        , _
        " Type=5;Jet OLEDB:Database Locking Mode=0;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 OLEDB:Don't Copy Locale on Com" _
        , _
        "pact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        ), Destination:=Range("A1"))
        .CommandType = xlCmdTable
        .CommandText = Array("YourTable/QueryName")
        .Name = "Accnt_be"
        .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 = "YourFullDatabasePathHere"
        .Refresh BackgroundQuery:=False
    End With