Runawaygeek
Registered User.
- Local time
- Today, 15:37
- Joined
- Mar 28, 2016
- Messages
- 77
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,
The SQL of my Query is:
The Export Code is:
All ideas welcome.
Thanks
Ben
The Export Code is by Author: Daniel Pineault, CARDA Consultants Inc.
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,
Code:
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:
Code:
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:
Code:
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.