Getting input box to feed query before function call (1 Viewer)

[Runawaygeek]

Hello,

So in my last post I got the answer to calling a function that will export a record set to Excel.

but the issue with that, is my where has a WHERE clause that requires the user to input a Date Range.

I am trying to get the VBA to get the data from the user then open the query and export to Excel.


My code is rough, but this is where im going with it,

MyDate1 = InputBox("Input Start Date   (dd/mm/yyyy)")
MyDate2 = InputBox("Input End Date   (dd/mm/yyyy)")
DoCmd.OpenQuery "Q_CountOfActionsbyClient", , , "[MyDateA]='" & MyDate1 & "'", "[MyDateB]='" & MyDate2 & "'"

Call ExcelExport

The SQL of my Query is:

SELECT DISTINCT AA.Full_Name, Count(AA.Activity) AS CountofActiveity
FROM (SELECT DISTINCT Contacts.Full_Name, Action_Record.Activity, Action_Record.[Date of Activity] FROM Contacts LEFT JOIN Action_Record ON Contacts.ID = Action_Record.Contact_ID)  AS AA
WHERE (((AA.[Date of Activity]) Between [MyDateA:] And [MyDateB]))
GROUP BY AA.Full_Name;

The Export Code is:

Function ExcelExport(ByVal Q_CountOfActionsbyClient As String)
    Dim oExcel          As Object
    Dim oExcelWrkBk     As Object
    Dim oExcelWrSht     As Object
    Dim bExcelOpened    As Boolean
    Dim db              As DAO.Database
    Dim rs              As DAO.Recordset
    Dim iCols           As Integer
    Const xlCenter = -4108
 
    'Start Excel
    On Error Resume Next
    Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel
 
    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set oExcel = CreateObject("Excel.Application")
        bExcelOpened = False
    Else    'Excel was already running
        bExcelOpened = True
    End If
    On Error GoTo Error_Handler
    oExcel.ScreenUpdating = False
    oExcel.Visible = False   'Keep Excel hidden until we are done with our manipulation
    Set oExcelWrkBk = oExcel.Workbooks.Add()    'Start a new workbook
    Set oExcelWrSht = oExcelWrkBk.Sheets(1)
 
    'Open our SQL Statement, Table, Query
    Set db = CurrentDb
    Set rs = db.OpenRecordset(Q_CountOfActionsbyClient, dbOpenSnapshot)
    With rs
        If .RecordCount <> 0 Then
            'Build our Header
            For iCols = 0 To rs.Fields.Count - 1
                oExcelWrSht.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
            Next
            With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                                   oExcelWrSht.Cells(1, rs.Fields.Count))
                .Font.Bold = True
                .Font.ColorIndex = 2
                .Interior.ColorIndex = 1
                .HorizontalAlignment = xlCenter
            End With
            oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _
                              oExcelWrSht.Cells(1, rs.Fields.Count)).Columns.AutoFit    'Resize our Columns based on the headings
            'Copy the data from our query into Excel
            oExcelWrSht.Range("A2").CopyFromRecordset rs
            oExcelWrSht.Range("A1").Select  'Return to the top of the page
        Else
            MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with"
            GoTo Error_Handler_Exit
        End If
    End With
 
    '    oExcelWrkBk.Close True, sFileName 'Save and close the generated workbook
 
    '    'Close excel if is wasn't originally running
    '    If bExcelOpened = False Then
    '        oExcel.Quit
    '    End If
 
Error_Handler_Exit:
    On Error Resume Next
    oExcel.Visible = True   'Make excel visible to the user
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set oExcelWrSht = Nothing
    Set oExcelWrkBk = Nothing
    oExcel.ScreenUpdating = True
    Set oExcel = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Export2XLS" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

All ideas welcome.

Thanks
Ben

The Export Code is by Author: Daniel Pineault, CARDA Consultants Inc.

 

[sxschech]

Shouldn't need to open the query. Change your query to an sql statement like this.

dim stsql as string

MyDate1 = InputBox("Input Start Date   (dd/mm/yyyy)")
MyDate2 = InputBox("Input End Date   (dd/mm/yyyy)")
stsql = "SELECT DISTINCT AA.Full_Name, Count(AA.Activity) AS CountofActiveity " & _
    "FROM (SELECT DISTINCT Contacts.Full_Name, Action_Record.Activity, Action_Record.[Date of Activity] " & _
              "FROM Contacts LEFT JOIN Action_Record ON Contacts.ID = Action_Record.Contact_ID)  AS AA " & _
    "WHERE AA.[Date of Activity] Between " & MyDate1 & "  And " & MyDate2  & " " & _
    "GROUP BY AA.Full_Name;"

Call ExcelExport (stsql)

Then in the function change Q_CountOfActionsbyClient to QueryName as shown below

Function ExcelExport(ByVal QueryName As String)

and also do that for the recordset. Rest of code should be ok.

Set rs = db.OpenRecordset(QueryName, dbOpenSnapshot)

 

[Runawaygeek]

Thanks for this, its looking much better than where i was going.
I see your point about running the SQL statement like that, however, its not picking up any results.

I know the names of tables are right and the join as i copied it from the built query design SQL view. When i run the query I get 47 rows, but the SQL here does not. Am I missing something stupidly simply?

Thanks again,
Ben

Dim MyDate1 As Variant
Dim MyDate2 As Variant
Dim stsql As String
MyDate1 = InputBox("Input Start Date   (dd/mm/yyyy)", "Date", Format(Now(), "dd/mm/yyyy"))
MyDate2 = InputBox("Input End Date   (dd/mm/yyyy)", "Date", Format(Now(), "dd/mm/yyyy"))

stsql = "SELECT DISTINCT AA.Full_Name, Count(AA.Activity) AS CountofActiveity " & _
    "FROM (SELECT DISTINCT Contacts.Full_Name, Action_Record.Activity, Action_Record.[Date of Activity] " & _
              "FROM Contacts LEFT JOIN Action_Record ON Contacts.ID = Action_Record.Contact_ID)  AS AA " & _
    "WHERE AA.[Date of Activity] Between " & MyDate1 & "  And " & MyDate2 & " " & _
    "GROUP BY AA.Full_Name;"

Call ExcelExport(stsql)

 

[Runawaygeek]

PS. I set a debug to check the dates where going in, they are..

Debug.Print stsql

CurrentDb.OpenRecordset stsql

 

[Runawaygeek]

Fixed it, it was missing #`s for dates..

"WHERE AA.[Date of Activity] Between #" & MyDate1 & "# And #" & MyDate2 & "# " & _

 

[Cronk]

In Access, SQL requires dates to be in US format eg #12/31/2016# for the last day of last year whereas your coding gives "31/12/2016"

Try

"WHERE AA.[Date of Activity] Between #" & format(MyDate1,"mm/dd/yyyy") & "# And #" & format(MyDate2,"mm/dd/yyyy")  & "# " & _

 

[Runawaygeek]

In Access, SQL requires dates to be in US format eg #12/31/2016# for the last day of last year whereas your coding gives "31/12/2016"

Try

"WHERE AA.[Date of Activity] Between #" & format(MyDate1,"mm/dd/yyyy") & "# And #" & format(MyDate2,"mm/dd/yyyy")  & "# " & _

Thanks, I read that too, but it seemed to be working ok.
Just in case though, i have added the Format()

Thanks,
Ben

 

[sxschech]

Sorry forgot about the date formatting. Mind was on something else when I posted that. Glad you and the others got it sorted out.