command button to run query and put results in Excel (VBA)

[RCBricker]

Hello everyone.

I have a new project that my supe wants in access rather than excel. I am comfortable writing code in excel. However, I am a little shaky on building DBs let alone using VBA. WTH I will learn. So I have to build a two-table database that then uses queries to produce paired down reports based on the tables in excel. I have uploaded the data from excel into Access and I have written the queries so that I get the results I expect. I have finally created a form that will utilize a text box to capture the fiscal year, and two separate list boxes (one for fiscal quarter and one for month). Once those are completed the user would then push a corresponding button to run one of three reports (monthly, quarterly or annually).

I am now on the whole on button click do portion of the database creation.

I want the button to launch the code that will create an excel document, check if there are four (4) worksheets and name them accordingly (create sheets if needs be), and based on the information provided on the user form (in access) amend the queries to pull the appropriate data and place in excel. then there are some formatting issues that will need to be addressed before saving.

here is the code for the user form (on button click or enter)

Option Compare Database
Option Explicit

Private Sub CMDBAnnual_Click()
    Call annual_report
End Sub

Private Sub CMDBAnnual_Enter()
    Call annual_report
End Sub

Private Sub CMDBmonth_Click()
    Call Monthly_report
End Sub

Private Sub CMDBmonth_Enter()
    Call Monthly_report
End Sub

Private Sub CMDBqrtly_Click()
    Call Quarterly_Report
End Sub

Private Sub CMDBqrtly_Enter()
    Call Quarterly_Report
End Sub

here is what I have been playing with for code in the module of access

Option Compare Database
Option Explicit
Dim dbRECON As Database
Dim dbPATH As String
Dim oEXCEL As Object
Dim oWB As Object


'**************************************************************************************
'Header label called LBLtopheader
'1st subheader called LBLsubheaderleft
'2nd subheader called LBLsubheaderright
'
'report form called "Report Form"
'
'1st query called "DCAS Data FY 2015 Query"
'
'2nd query called "DCAS Detail Monthly Query" ** need this for DCAS detail for 3rd
'excel tab
'
'3rd query called "DCAS Monthly Total Query" ** need this for DCAS summary 2nd excel
'tab
'
'4th query called "EBAS Data FY 2015 Query"
'5th query called "EBAS Detail Monthly Total Query"
'7th query called "EBAS Detail no zero value Query" **need this for upper detail
'of 4th excel tab
'
'7th query called "EBAS Detail zero value Query" **need this for lower detail of 4th
'excel tab
'
'8th query called "EBAS Monthly Total Query" ** need this for EBAS summary 2nd excel
'tab
'**************************************************************************************

Public Sub annual_report()
Set dbRECON = Application.CurrentDb
dbPATH = Application.CurrentProject.Path
Set oEXCEL = CreateObject("Excel.application")
    oEXCEL.Application.ScreenUpdating = False
    oEXCEL.Visible = True
DoCmd.OpenForm "reportform"

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
oWB.Name = "2612 DCAS to EBAS-TJS " & Forms("ReportForm")!TXTannual.Value
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&


' text box called TXTannual set variable to TXTannual.value
End Sub
Private Sub Monthly_report()
Set dbRECON = Application.CurrentDb
dbPATH = Application.CurrentProject.Path
MsgBox dbPATH

' list box called LISTmonth set variable to LISTmonth.value
End Sub
Private Sub Quarterly_Report()

Set dbRECON = Application.CurrentDb
dbPATH = Application.CurrentProject.Path
' list box called LISTqrtly set variable to LISTqrtly.value
End Sub

I get a run time error '91' when I try and run the code (section of code is between the '&&& lines.

I look forward to learning more about VBA in access and access in general, but I really need to figure this out.

Thanks in advance

rich

 

[Micron]

If I recall, error 91 is 'object variable or with block variable not set' or something. You should always post the error text and number.
If the first case, it means you are trying to use an object that you have not declared AND set. I see where you delcared oWB but I don't see where you created it with the SET statement before you try to use it:
oWB.Name = "2612 DCAS to EBAS-TJS " & Forms("ReportForm")!TXTannual.Value

Upon quick review, I'll say that I've never seen anyone use the Enter event for a button. Didn't even know you could and don't see the need for it unless maybe you intend to tie it into the Enter key somehow.
Also, some tips:
- when you have to control several properties of a single object (your way fine for a couple but not wrong either):

Set oEXCEL = CreateObject("Excel.application")
With oEXCEL

.Application.ScreenUpdating = False​

.Visible = True
.DisplayAlerts = False
.etc
​

End With

- always use error trapping routines for something like this, and ensure you undo the states you are setting. Otherwise, you could end up with an Excel session left open that you cannot see or an option setting that becomes permanent

- I don't see where you destroyed the objects at the end of the code by setting them to Nothing
- better to declare the object library when you know it rather than force Access to figure it out:
Dim db as DAO.database (or DAO.recordset, etc.)
-unless you are working with two db's at the same time, Set db=currentdb is enough
- if you're going to set the dbPath in the declarations section, might as well set the property there too instead of doing it for every event in the module.
That's it for now, I guess.

 

[RCBricker]

Micron,

the reason for the enter key being used is that my supervisor is big on tabbing through documents and using hot keys (might be afraid of mice...not sure), so I am including that in case he uses the enter key.

you are right I forgot to set the variable and that is why I got the error. I looked at your suggestions and incorporated what I knew how to do. For the other suggestions, I have a couple questions. First I have changed my code to fix some of the issues (see below). I was finally able to create and begin formatting the excel document.

I am just not trying to figure out how to have specific queries run and the values sent to the appropriate worksheet in my excel document.

there were no changes on the form code sheet

Module code sheet

Option Compare Database
Option Explicit
Dim Xl As eXcel.Application, Xwb As eXcel.Workbook, XWScomp As eXcel.Worksheet
Dim db As DAO.Database, dbREC As DAO.Recordset, dbF As DAO.Field
XWSvs As eXcel.Worksheet, XWSdcas As eXcel.Worksheet, XWSebas As eXcel.Worksheet

'**************************************************************************************
'Header label called LBLtopheader
'1st subheader called LBLsubheaderleft
'2nd subheader called LBLsubheaderright
'
'report form called "Report Form"
'
'1st query called "DCAS Data FY 2015 Query"
'
'2nd query called "DCAS Detail Monthly Query" ** need this for DCAS detail for 3rd
'excel tab
'
'3rd query called "DCAS Monthly Total Query" ** need this for DCAS summary 2nd excel
'tab
'
'4th query called "EBAS Data FY 2015 Query"
'5th query called "EBAS Detail Monthly Total Query"
'7th query called "EBAS Detail no zero value Query" **need this for upper detail
'of 4th excel tab
'
'8th query called "EBAS Detail zero value Query" **need this for lower detail of 4th
'excel tab
'
'9th query called "EBAS Monthly Total Query" ** need this for EBAS summary 2nd excel
'tab
'**************************************************************************************

Public Sub annual_report(TXTvar As String)
' text box called TXTannual set variable to TXTannual.value

Dim lrow As Long, lcol As Long
Dim i As Integer, j As Integer, k As Variant
Dim rng As Range, cell As Range

' Prepare your Excel stuff
Set Xl = New eXcel.Application
    With Xl
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Visible = True
    End With
Set Xwb = Xl.Workbooks.Add
Xwb.Activate
Set Xcomp = Xwb.ActiveSheet
Xcomp.Name = "Comp" 'add FY & year OR year & quarter OR year & month name
k = Xwb.Worksheets.Count

Do Until k = 5
    Select Case k
        Case k = 1
            With Xcomp
                With Xcomp.Tab
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                End With
                ' add query "DCAS Detail Monthly Query" starting at B1
                ' add query "EBAS Detail Monthly Query" starting at one row below the
                ' DCAS data
                ' Filter each separately
            End With
        Case k = 2
        Case k = 3
        Case k = 4
        Case Else
    End Select
Loop

'save excel document to same folder as database



End Sub
Public Sub Monthly_report()

' list box called LISTmonth set variable to LISTmonth.value
End Sub
Public Sub Quarterly_Report()

' list box called LISTqrtly set variable to LISTqrtly.value
End Sub

any help pointing me in the right directions for running and exporting queries would be greatly appreciated. (Man I wish access had a record macro button)

rich

 

[RCBricker]

ok so I can get the query to write into excel with a loop I found. However, I tried the docmd with the spreadsheet type and it kept erroring out which let to the loop.

the problem with the loop is it does not export the field names in the query to excel.

Any ideas?

Dim Xl As eXcel.Application, Xwb As eXcel.Workbook, XWScomp As eXcel.Worksheet
Dim db As DAO.Database, dbREC As DAO.Recordset, dbF As DAO.Field, qry As QueryDef
Dim XWSvs As eXcel.Worksheet, XWSdcas As eXcel.Worksheet, XWSebas As eXcel.Worksheet

'**************************************************************************************
'Header label called LBLtopheader
'1st subheader called LBLsubheaderleft
'2nd subheader called LBLsubheaderright
'
'report form called "Report Form"
'
'1st query called "DCAS Data FY 2015 Query"
'
'2nd query called "DCAS Detail Monthly Query" ** need this for DCAS detail for 3rd
'excel tab
'
'3rd query called "DCAS Monthly Total Query" ** need this for DCAS summary 2nd excel
'tab
'
'4th query called "EBAS Data FY 2015 Query"
'5th query called "EBAS Detail Monthly Total Query"
'7th query called "EBAS Detail no zero value Query" **need this for upper detail
'of 4th excel tab
'
'8th query called "EBAS Detail zero value Query" **need this for lower detail of 4th
'excel tab
'
'9th query called "EBAS Monthly Total Query" ** need this for EBAS summary 2nd excel
'tab
'**************************************************************************************

Public Sub annual_report()
' text box called TXTannual set variable to TXTannual.value

Dim lrow As Long, lcol As Long
Dim i As Integer, j As Integer, h As Integer, k As Variant, x As Variant
Dim rng As Range, cell As Range
Dim dbFP As String, xFN As String


Set db = CurrentDb

dbFP = CurrentProject.Path & "\"
' Prepare your Excel stuff
Set Xl = New eXcel.Application
    With Xl
        '.ScreenUpdating = False
        .DisplayAlerts = False
        .Visible = True
    End With
Set Xwb = Xl.Workbooks.Add
Xwb.Activate
Xwb.SaveAs dbFP & "DCAS to EBAS " & "" & " Reconcilitation.xlsx"
xFN = Xwb.Path
Set XWScomp = Xwb.ActiveSheet
XWScomp.Name = "Comp" 'add FY & year OR year & quarter OR year & month name
k = Xwb.Worksheets.Count

Do Until k = 5
    If k = 1 Then
        With XWScomp
            With XWScomp.Tab
                .ThemeColor = xlThemeColorLight1
                .TintAndShade = 0
            End With
            ' add query "DCAS Detail Monthly Query" starting at B1
            ' add query "EBAS Detail Monthly Query" starting at one row below the
            ' DCAS data
            ' Filter each separately
        End With
        k = k + 1
    Else
       If k = 2 Then
            Xwb.Worksheets.Add after:=Worksheets(Worksheets.Count)
            Set XWSvs = ActiveSheet

            With XWSvs
                .Name = "DCAS vs EBAS"
                .Tab.Color = 255
                
                ' add query "DCAS Monthly Total Query" starting at A3
                ' add query "EBAS Monthly Total Query" starting two columns to the
                ' the right of DCAS data
                ' create variance section two columns to the right of EBAS
                ' add formulas to variance section to compare DCAS to EBAS totals
                ' and counts
            End With
            k = k + 1
        Else
            If k = 3 Then
                Xwb.Worksheets.Add after:=Worksheets(Worksheets.Count)
                Set XWSdcas = ActiveSheet
                With XWSdcas
                    With XWSdcas
                        .Name = "2612 EBAS" 'add FY & year OR year & quarter OR
                                            'year & month name
                        With XWSdcas.Tab
                            .ThemeColor = xlThemeColorAccent1
                            .TintAndShade = -0.249977111117893
                        End With
                    Set qry = db.QueryDefs("DCAS Detail Monthly Query")
                    Set dbREC = qry.OpenRecordset
                    Set rng = Cells(1, 1)
                    lrow = Range("A" & .Rows.Count).End(xlUp).Row
                    h = 1
                        Do Until dbREC.EOF
                            For Each x In dbREC.Fields
                                XWSdcas.Cells(lrow, h).Formula = x
                                h = h + 1
                            Next x
                            lrow = lrow + 1
                            h = 1
                            dbREC.MoveNext
                        Loop
                
                    ' add query "DCAS Detail Monthly Query" starting at A1
                    ' Header row should be red with white font
                    End With
                End With
                k = k + 1
            Else
                If k = 4 Then
                    Xwb.Worksheets.Add after:=Worksheets(Worksheets.Count)
                    Set XWSebas = ActiveSheet
                    With XWSebas
                        With XWSebas
                            .Name = "2612 EBAS" 'add FY & year OR year & quarter OR
                                                'year & month name
                            .Tab.Color = 5287936
                            
                        ' add query "EBAS Detail Monthly Query" starting at A1
                        ' Header row should be light blue
                        End With
                    End With
                    k = k + 1
                Else
                    k = k + 1
                End If
            End If
        End If
    End If
Loop


    With Xl
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
Set XWScomp = Nothing
Set XWSvs = Nothing
Set XWSdcas = Nothing
Set XWSebas = Nothing

Xwb.Save
Xwb.Close
Set Xwb = Nothing
Xl.Quit
Set Xl = Nothing



End Sub

thanks
rich

 

[Micron]

[ok so I can get the query to write into excel with a loop I found. However, I tried the docmd with the spreadsheet type and it kept erroring out which let to the loop.] - this I don't understand.

As always, we make progress then run into another roadblock! OK, now you are over-doing the With thing. I only use it where there are 3 or more properties I need to set as it does not require me to repeat the object name on every line, plus it compartmentalizes things a bit. A couple of yours are so far apart that I really had to look at where you ended them. Normally, you should not have so much unrelated code buried within them, nor should you nest them if not req'd.

With XWSdcas

With XWSdcas
.Name = "26

​

You still don't show an error handler. Note in my code how this messages the user (not always the action taken) and given that any error means total failure, execution resumes at ExitHere: THEN destroys the objects or resets properties and returns False to the calling procedure where I deal with the failure there.

Here's how I handle the data push to Excel. What's going on here is that I have done all the workbook opening stuff on my form, then I pass the workbook object and a flag (to tell me what workbook we're dealing with) to the function and return a boolean result of true or false to the calling procedure (did it succeed or not). I am dealing with the same workbooks each time; you would create new and pass it to the function. You asked how to write the column names. I've never used that part of my code, so you probably would just need to turn it on and tweak it to suit. One think I really like about this code is that it will handle as many query fields as you have (unless you exceed Excel's limit I guess). I replaced some names with gibberish to protect the innocent. Also, I don't format my code the way you'll see it - I'm too lazy to indent all those lines!

Function PushChartData(ByRef xlw As Object, flag As String) As Boolean
Dim lngColumn As Long
Dim xls As Object, xlc As Object
Dim db As DAO.Database, rst As DAO.Recordset
Dim msg As String, rnge1 As String, rnge2 As String
Dim shtName As String, cellStart As String

On Error GoTo errHandler
Set db = CurrentDb()
msg = "No " & flag & " records were retrieved." & vbCrLf
msg = msg & "Contact a database administrator if this is an error."

If flag = "asdfd dfaffa" Then
shtName = "DATA"
rnge1 = "DateRange"
rnge2 = "DailyCountRange"
cellStart = "A6"
Set rst = db.OpenRecordset("qryM;kj;pk", dbOpenDynaset, dbReadOnly)
End If

If flag = "Weekly Summary" Then
shtName = "ppjkj;kj"
rnge1 = "WeekNum"
rnge2 = "rfjrytuj"
cellStart = "A3"
Set rst = db.OpenRecordset("qryTafasfdadsf", dbOpenDynaset, dbReadOnly)
End If

If rst.RecordCount = 0 Then
MsgBox msg
PushChartData = False
Exit Function
End If

Set xls = xlw.Worksheets(shtName)
With xls
'delete data in the ranges in case fewer records are being entered
.Range(rnge1).ClearContents
.Range(rnge2).ClearContents
End With
Set xlc = xls.Range(cellStart) ' this is the top left cell into which data goes
rst.MoveFirst

'enable next block to write data column headers (NOT TESTED)
'**********************************************
'For lngColumn = 0 To rst.Fields.count - 1
'xlc.Offset(0, lngColumn).value = rst.Fields(lngColumn).Name
'Next lngColumn
'Set xlc = xlc.Offset(1, 0)'offset 1 row IF the headers were written
'***********************************************

Set xlc = xlc.Offset(0, 0) 'if headers not written, no offset from cellStart
' write data to worksheet
Do While Not rst.EOF
For lngColumn = 0 To rst.Fields.count - 1
xlc.Offset(0, lngColumn).value = rst.Fields(lngColumn).value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
PushChartData = True

exitHere:
On Error Resume Next
rst.Close
Set db = Nothing
Set rst = Nothing
Set xls = Nothing
flag = ""
PushChartData = False
Exit Function

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere
End Function