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

M

markzaal

Registered User.
Local time
Today, 23:49
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
 
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
Click to expand...
 
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
 
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.
 
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..
 
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
 
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
 
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..
 
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
Click to expand...
 
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"...
 
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,

attachment.php
 
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;
 
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
 
It now does open Excel but it remains empty eventhough the query does work and shows me the correct info...
 
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..
 
It gives me a syntax error for the very first "Format" already...
 
There is a Field called From - 1 - To.. Replace it like..
Code: 
Format([From - 1 - To], 'Short Time')
 
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
 
You must log in or register to reply here.

Similar threads

B
  • Question Question
export and transpose problem
Replies
8
Views
335
Pat Hartman
P
J
Use VBA to export form data to Excel, but keep getting "We Found a Problem..." when opening the file in Excel
Replies
5
Views
338
June7
June7
J
Export data in Work to different folders
Replies
2
Views
215
JPR
J
R
Closing all MDI child forms when Ctrl-F4 not available
Replies
6
Views
385
Pat Hartman
P
Uncle Gizmo
Does Microsoft Access 2024 (Professional Plus 2024) Export Forms as Text for Re-Import?
Replies
14
Views
555
Josef P.
J

Users who are viewing this thread

Total: 2 (members: 0, guests: 2)
Back
Top Bottom