VBA to export query to Excel and open Excel without saving (1 Viewer)

markzaal

Registered User
Joined
Jan 15, 2013
Messages
50
Access 2010

Hi All,

I am trying to export certain info from a query into Excel and have Excel open after export using VBA.

Right now I use the "DoCmd.TransferSpreadsheet" command which lets me export the query and save it to an Excel file with a certain filename I have chosen. This works fine. However....

I would like to just have it open the Excel workbook after exporting without saving it or giving it a certain filename. This way, when the Excel workbook is open, the user can either extract the info from the workbook he/she wants without saving at all or use the "save as" button to name the file and store wherever he/she likes.

Any help will be much appreciated!

Thanks!

Mark
 

Trevor G

Registered User
Joined
Oct 1, 2009
Messages
2,331
Hi Mark take a look at this code, change the query name and give it a go.

Sub trans1()
'Step 1: Declare your variables
Dim MyDatabase As DAO.Database
Dim MyQueryDef As DAO.QueryDef
Dim MyRecordset As DAO.Recordset
Dim i As Integer
'Step 2: Identify the database and query
Set MyDatabase = CurrentDb
Set MyQueryDef = MyDatabase.QueryDefs("qryEquipment") 'Query name in the database
'Step 3: Open the query
Set MyRecordset = MyQueryDef.OpenRecordset
'Step 4: Clear previous contents
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.Workbooks.Add
.Sheets("Sheet1").Select
'Step 5: Copy the recordset to Excel
.ActiveSheet.Range("A2").CopyFromRecordset MyRecordset
'Step 6: Add column heading names to the spreadsheet
For i = 1 To MyRecordset.Fields.Count
xlApp.ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
Next i
xlApp.Cells.EntireColumn.AutoFit
End With
'MsgBox "Query has been successful", vbInformation, "Sample"
End Sub
 

markzaal

Registered User
Joined
Jan 15, 2013
Messages
50
Hi Trevor,

First of all thanks for the help! I do get an error however...

On the "Set MyRecordset = MyQueryDef.OpenRecordset" I get the error: 3061; Too few parameters. Expected 1.

Any thoughts?

Thanks again!

Mark
 

Trevor G

Registered User
Joined
Oct 1, 2009
Messages
2,331
Two options Mark can you show me the adapted code, did you change the query name in the code? Second can you zip a copy of the database (don't show any sensitive data) and add it to your thread, it must be less than 2mg I can then take a look.
 

pr2-eugin

Super Moderator
Joined
Nov 30, 2011
Messages
8,498
Mark, the Query needs to be a non-parametrized Query.. What you are facing is because the Query you are trying to export will prompt for a parameter to be entered.. Unlike the DoCmd.TransferSpreadsheet, the method Trevor gave you will fail..

Trevor has given you a starting point.. You can dynamically create the QueryDef and then take it from there..
 

markzaal

Registered User
Joined
Jan 15, 2013
Messages
50
Hi Trevor,

I am afraid the DB is over 2MB zipped...

I use the code like this (it also shows what I used before)

Private Sub Command75_Click()

'Dim filename As String

'filename = Me.disk & ":\Airdive 1 Activities-" & Me.ProjectNumber & ".xls"

'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "DivingActivitiesAir1ProjectQExport", filename, True

'DoCmd.Close


'Sub trans1()
'Step 1: Declare your variables
Dim MyDatabase As DAO.Database
Dim MyQueryDef As DAO.QueryDef
Dim MyRecordset As DAO.Recordset
Dim i As Integer
'Step 2: Identify the database and query
Set MyDatabase = CurrentDb
Set MyQueryDef = MyDatabase.QueryDefs("DivingActivitiesAir1ProjectQExport") 'Query name in the database
'Step 3: Open the query
Set MyRecordset = MyQueryDef.OpenRecordset
'Step 4: Clear previous contents
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.Workbooks.Add
.Sheets("Sheet1").Select
'Step 5: Copy the recordset to Excel
.ActiveSheet.Range("A2").CopyFromRecordset MyRecordset
'Step 6: Add column heading names to the spreadsheet
For i = 1 To MyRecordset.Fields.Count
xlApp.ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
Next i
xlApp.Cells.EntireColumn.AutoFit
End With
'MsgBox "Query has been successful", vbInformation, "Sample"
End Sub
 

markzaal

Registered User
Joined
Jan 15, 2013
Messages
50
Hi Paul,

Thanks for your reply. I am afraid my VBA skills are not up to the task of dynamically creating the QueryDef...

You are right that I have the user select a projectnumber on the form I use to export the data, which is used as an imput parameter in the query.

Mark
 

pr2-eugin

Super Moderator
Joined
Nov 30, 2011
Messages
8,498
Okay, this is how your CODE should look like.. You need to copy the Query that you already have built in and then assign it to the Varibale strSQL..
Code:
Private Sub Command75_Click()
[COLOR=SeaGreen]'Step 1: Declare your variables[/COLOR]
    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    [COLOR=Red]Dim strSQL As String[/COLOR]
    Dim i As Integer
    
    [COLOR=Red]strSQL = "SELECT[/COLOR] [COLOR=Blue]theFields[/COLOR] [COLOR=Red]FROM[/COLOR] [COLOR=Blue]theTableName[/COLOR] [COLOR=Red]WHERE[/COLOR] [COLOR=Blue]someField = " & Me.ControlName & [/COLOR][COLOR=Red]";"[/COLOR]
[COLOR=Green]'Step 2: Identify the database and query[/COLOR]
    Set MyDatabase = CurrentDb
[COLOR=Red]On Error Resume Next[/COLOR]
    [COLOR=Red]With MyDatabase
        .QueryDefs.Delete ("tmpOutQry")
        Set MyQueryDef = .CreateQueryDef("tmpOutQry", strSQL)
        .Close
    End With[/COLOR]
[COLOR=Green]'Step 3: Open the query[/COLOR]
    Set MyRecordset = MyQueryDef.OpenRecordset
[COLOR=Green]'Step 4: Clear previous contents[/COLOR]
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
        .Visible = True
        .Workbooks.Add
        .Sheets("Sheet1").Select
[COLOR=Green]'Step 5: Copy the recordset to Excel[/COLOR]
        .ActiveSheet.Range("A2").CopyFromRecordset MyRecordset
[COLOR=Green]'Step 6: Add column heading names to the spreadsheet[/COLOR]
        For i = 1 To MyRecordset.Fields.Count
            xlApp.ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
        Next i
        xlApp.Cells.EntireColumn.AutoFit
    End With
End Sub
I have highlighted the parts I have changed, make sure they match up according to your design.. Hope that helps..
 

Trevor G

Registered User
Joined
Oct 1, 2009
Messages
2,331
Adjusted the code to use ADO, set the references as indicated

Function Excel05082013()
'*************************************************
'VBA Code created by Trevor G
'You need to set Reference to use Excel and Microsoft ADO
'Tools Menu --> References --> Microsoft Excel XX Object Library
'And Microsoft ActiveX Data Object XX Object Library
'*************************************************
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim strPath As String
Dim ws As Excel.Application
Dim i As Long
'*************************************************
'First stage is to take the first query and place it
'On sheet1
'*************************************************
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM qryEquipment"
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rst.MoveFirst
Set ws = CreateObject("Excel.Application")
With ws
.Workbooks.Add
.Visible = True
End With
ws.Sheets("sheet1").Select
For i = 0 To rst.Fields.Count - 1
ws.ActiveCell.Offset(0, i).Value = rst.Fields(i).Name
Next
ws.Range("a2").CopyFromRecordset rst
ws.Columns("A:Q").EntireColumn.AutoFit
rst.Close
End Function
 

markzaal

Registered User
Joined
Jan 15, 2013
Messages
50
Trevor, I still get the too few parameters error...

Paul, I have nio experience with SQL and am not really sure what to fill in on the parts you have highlighted in blue...
I have a table "DivingActivitiesAir1T" with one of the fields "ProjectNumber". I use this as a Where criteria in the query "DivingActivitiesAir1ProjectQExport" from the form [Forms]![Airdive1ExportF]![projectnumber] which has the button "Command75"...
 

pr2-eugin

Super Moderator
Joined
Nov 30, 2011
Messages
8,498
Could you switch to the SQL view of the Query you want to use and copy and paste it here? To get the SQL view use,

 

markzaal

Registered User
Joined
Jan 15, 2013
Messages
50
Haha. Thanks for that very clear picture Paul!

SELECT DivingActivitiesAir1T.ProjectNumber, DivingActivitiesAir1T.DPRDate, DivingActivitiesAir1T.DPRNumber, DivingActivitiesAir1T.DiveNr, Format([From],"Short Time") AS [Start time], Format([To],"Short Time") AS [End time], Sum(TimeValue([Duration])*1440) AS [Duration (min)], Format([From]-1-[To],"Short Time") AS Duration, DivingActivitiesAir1T.Acitivity AS Activity, DivingActivitiesAir1T.Details, DivingActivitiesAir1T.Code, DivingActivitiesAir1T.DPRCode, DivingActivitiesAir1T.Diver1, DivingActivitiesAir1T.DiveTime1M AS DiveTime1, DivingActivitiesAir1T.Depth1, DivingActivitiesAir1T.DecoTime1, DivingActivitiesAir1T.Diver2, DivingActivitiesAir1T.DiveTime2M AS DiveTime2, DivingActivitiesAir1T.Depth2, DivingActivitiesAir1T.DecoTime2, DivingActivitiesAir1T.Diver3, DivingActivitiesAir1T.DiveTime3M AS DiveTime3, DivingActivitiesAir1T.Depth3, DivingActivitiesAir1T.DecoTime3, DivingActivitiesAir1T.StbDiver, DivingActivitiesAir1T.DiveTimeStM AS DiveTimeStb, DivingActivitiesAir1T.DepthStb, DivingActivitiesAir1T.DecoTimeStb, DivingActivitiesAir1T.SOLnr, DivingActivitiesAir1T.Gas, DivingActivitiesAir1T.StorageDepthBell, DivingActivitiesAir1T.SignWaveHeight, DivingActivitiesAir1T.Location, DivingActivitiesAir1T.SOW, DivingActivitiesAir1T.DeckDive AS [Deck/Dive], DivingActivitiesAir1T.State, DivingActivitiesAir1T.NameOrCode
FROM DivingActivitiesAir1T
WHERE (((DivingActivitiesAir1T.ProjectNumber)=[Forms]![Airdive1ExportF]![projectnumber]))
GROUP BY DivingActivitiesAir1T.ProjectNumber, DivingActivitiesAir1T.DPRDate, DivingActivitiesAir1T.DPRNumber, DivingActivitiesAir1T.DiveNr, DivingActivitiesAir1T.Acitivity, DivingActivitiesAir1T.Details, DivingActivitiesAir1T.Code, DivingActivitiesAir1T.DPRCode, DivingActivitiesAir1T.Diver1, DivingActivitiesAir1T.DiveTime1M, DivingActivitiesAir1T.Depth1, DivingActivitiesAir1T.DecoTime1, DivingActivitiesAir1T.Diver2, DivingActivitiesAir1T.DiveTime2M, DivingActivitiesAir1T.Depth2, DivingActivitiesAir1T.DecoTime2, DivingActivitiesAir1T.Diver3, DivingActivitiesAir1T.DiveTime3M, DivingActivitiesAir1T.Depth3, DivingActivitiesAir1T.DecoTime3, DivingActivitiesAir1T.StbDiver, DivingActivitiesAir1T.DiveTimeStM, DivingActivitiesAir1T.DepthStb, DivingActivitiesAir1T.DecoTimeStb, DivingActivitiesAir1T.SOLnr, DivingActivitiesAir1T.Gas, DivingActivitiesAir1T.StorageDepthBell, DivingActivitiesAir1T.SignWaveHeight, DivingActivitiesAir1T.Location, DivingActivitiesAir1T.SOW, DivingActivitiesAir1T.DeckDive, DivingActivitiesAir1T.State, DivingActivitiesAir1T.NameOrCode, DivingActivitiesAir1T.From, DivingActivitiesAir1T.To
ORDER BY DivingActivitiesAir1T.DPRDate, DivingActivitiesAir1T.From;
 

pr2-eugin

Super Moderator
Joined
Nov 30, 2011
Messages
8,498
Okay That is quiet a big query.. Well try the following.. This should work with no trouble.. Just make sure they are properly concatenated.. Although every care has been taken to adapt it, if there is some problem, please amend it..
Code:
Private Sub Command75_Click()
[COLOR=SeaGreen]'Step 1: Declare your variables[/COLOR]
    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    [COLOR=Red]Dim strSQL As String[/COLOR]
    Dim i As Integer
    
        strSQL = "SELECT DivingActivitiesAir1T.ProjectNumber, DivingActivitiesAir1T.DPRDate, DivingActivitiesAir1T.DPRNumber, DivingActivitiesAir1T.DiveNr, " & _
             "Format([From],'Short Time') AS [Start time], Format([To],'Short Time') AS [End time], Sum(TimeValue([Duration])*1440) AS [Duration (min)], " & _
             "Format([From]-1-[To],'Short Time') AS Duration, DivingActivitiesAir1T.Acitivity AS Activity, DivingActivitiesAir1T.Details, DivingActivitiesAir1T.Code, " & _
             "DivingActivitiesAir1T.DPRCode, DivingActivitiesAir1T.Diver1, DivingActivitiesAir1T.DiveTime1M AS DiveTime1, DivingActivitiesAir1T.Depth1, " & _
             "DivingActivitiesAir1T.DecoTime1, DivingActivitiesAir1T.Diver2, DivingActivitiesAir1T.DiveTime2M AS DiveTime2, DivingActivitiesAir1T.Depth2, " & _
             "DivingActivitiesAir1T.DecoTime2, DivingActivitiesAir1T.Diver3, DivingActivitiesAir1T.DiveTime3M AS DiveTime3, DivingActivitiesAir1T.Depth3, " & _
             "DivingActivitiesAir1T.DecoTime3, DivingActivitiesAir1T.StbDiver, DivingActivitiesAir1T.DiveTimeStM AS DiveTimeStb, DivingActivitiesAir1T.DepthStb, " & _
             "DivingActivitiesAir1T.DecoTimeStb, DivingActivitiesAir1T.SOLnr, DivingActivitiesAir1T.Gas, DivingActivitiesAir1T.StorageDepthBell, " & _
             "DivingActivitiesAir1T.SignWaveHeight, DivingActivitiesAir1T.Location, DivingActivitiesAir1T.SOW, DivingActivitiesAir1T.DeckDive AS [Deck/Dive], " & _
             "DivingActivitiesAir1T.State, DivingActivitiesAir1T.NameOrCode FROM DivingActivitiesAir1T WHERE (((DivingActivitiesAir1T.ProjectNumber) = " & _
             [Forms]![Airdive1ExportF]![projectnumber] & ")) GROUP BY DivingActivitiesAir1T.ProjectNumber, DivingActivitiesAir1T.DPRDate, " & _
             "DivingActivitiesAir1T.DPRNumber, DivingActivitiesAir1T.DiveNr, DivingActivitiesAir1T.Acitivity, DivingActivitiesAir1T.Details, DivingActivitiesAir1T.Code, " & _
             "DivingActivitiesAir1T.DPRCode, DivingActivitiesAir1T.Diver1, DivingActivitiesAir1T.DiveTime1M, DivingActivitiesAir1T.Depth1, DivingActivitiesAir1T.DecoTime1, " & _
             "DivingActivitiesAir1T.Diver2, DivingActivitiesAir1T.DiveTime2M, DivingActivitiesAir1T.Depth2, DivingActivitiesAir1T.DecoTime2, DivingActivitiesAir1T.Diver3, " & _
             "DivingActivitiesAir1T.DiveTime3M, DivingActivitiesAir1T.Depth3, DivingActivitiesAir1T.DecoTime3, DivingActivitiesAir1T.StbDiver,  " & _
             "DivingActivitiesAir1T.DiveTimeStM, DivingActivitiesAir1T.DepthStb, DivingActivitiesAir1T.DecoTimeStb, DivingActivitiesAir1T.SOLnr,  " & _
             "DivingActivitiesAir1T.Gas, DivingActivitiesAir1T.StorageDepthBell, DivingActivitiesAir1T.SignWaveHeight, DivingActivitiesAir1T.Location, " & _
             "DivingActivitiesAir1T.SOW, DivingActivitiesAir1T.DeckDive, DivingActivitiesAir1T.State, DivingActivitiesAir1T.NameOrCode, DivingActivitiesAir1T.From, " & _
             "DivingActivitiesAir1T.To ORDER BY DivingActivitiesAir1T.DPRDate, DivingActivitiesAir1T.From;"

[COLOR=Green]'Step 2: Identify the database and query[/COLOR]
    Set MyDatabase = CurrentDb
[COLOR=Red]On Error Resume Next[/COLOR]
    [COLOR=Red]With MyDatabase
        .QueryDefs.Delete ("tmpOutQry")
        Set MyQueryDef = .CreateQueryDef("tmpOutQry", strSQL)
        .Close
    End With[/COLOR]
[COLOR=Green]'Step 3: Open the query[/COLOR]
    Set MyRecordset = MyQueryDef.OpenRecordset
[COLOR=Green]'Step 4: Clear previous contents[/COLOR]
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
        .Visible = True
        .Workbooks.Add
        .Sheets("Sheet1").Select
[COLOR=Green]'Step 5: Copy the recordset to Excel[/COLOR]
        .ActiveSheet.Range("A2").CopyFromRecordset MyRecordset
[COLOR=Green]'Step 6: Add column heading names to the spreadsheet[/COLOR]
        For i = 1 To MyRecordset.Fields.Count
            xlApp.ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
        Next i
        xlApp.Cells.EntireColumn.AutoFit
    End With
End Sub
 

markzaal

Registered User
Joined
Jan 15, 2013
Messages
50
It now does open Excel but it remains empty eventhough the query does work and shows me the correct info...
 

pr2-eugin

Super Moderator
Joined
Nov 30, 2011
Messages
8,498
Hmmm.. The code would have generated a Query alongside the other Stored Queries.. Double click and see if it has returned the expected result.. Try Debugging the generated strSQL..
 

pr2-eugin

Super Moderator
Joined
Nov 30, 2011
Messages
8,498
There is a Field called From - 1 - To.. Replace it like..
Code:
Format([From - 1 - To], 'Short Time')
 

Bestse

New member
Joined
Nov 25, 2014
Messages
1
If you use OutputTo the final True indicates to open the Excel File after Creating it.
DoCmd.OutputTo acOutputQuery, "YourQueryName", acFormatXLS, "FilePath and FileName" & ".xls", , True
 

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

Top Bottom