P
Pat Dools
Hello,
I run the following code from behind a command button in an Access database.
It produces the file fine, but when I open the file, I would like to
worksheet named 'SOURCE' to be hidden, and for the pivot table data to be
refreshed. Are there some lines of code I can add to make this happen?
Here is the code:
Option Compare Database
Option Explicit
Function CreateExcelReport(strQueryName As String) As Boolean
'Turn off any access warning and prompts
DoCmd.SetWarnings False
'Get current Database location.
'Used as a variable b/c individual drive mappings may vary
Dim db As DAO.Database, strPath As String, strDir As String
Set db = CurrentDb()
strPath = CurrentDb.Name
strDir = Left$(strPath, Len(strPath) - Len(Dir(strPath)) - 1) & "\"
'Set Report Export Path and File Name w/ last Sunday's date
Dim strReportPath, strFileName As String
strReportPath = strDir & "Report_Exports\"
strFileName = strReportPath & strQueryName & "_" &
Replace(Forms![frm_MAIN_MENU]![txtRptEnd], "/", "") & ".xls"
'Calculate Prior Sunday's Date = [Todays Date] -
(WhatDayInTheWeekIsToday) + 1 = LAST SUNDAY
'ie. Fri 10/24:
' Friday is 6th Day in the Week, Sunday is 1st Day in the
Week, so need to go back 5 days.
' [10/24] - (6)+ 1 = 10/19
'Dim strDate
'strDate = Date - Weekday(Date, vbSunday) + 1
'strFileName = strReportPath & "ReportTitle_" & Format(strDate,
"dddd mm-dd-yyyy") & ".xls"
'Path and FileName for TEMPLATE Files. Could use queryName in Template
FileName to permit
'using function with mulitple templates
Dim strTemp As String
strTemp = strReportPath & "doNotTouch_BLANK_TEMPLATE\" & strQueryName &
"_TEMP.xls"
'strTemp = strReportPath &
"doNotTouch_BLANK_TEMPLATE\AllRecordsAsOfYesterday_TEMP.xls"
'Get and Set String Values for Report Headings - Title, Run Dates, Eff
Dates, etc.
Dim strTitle, strClaimDate, strRunDate
strTitle = "Default Title"
'Build Report title using values on Main Form (frm_MAIN_MENU)
strTitle = "Acknowledgment Information on Quotes/Policies Created
Between " & _
Forms![frm_MAIN_MENU]![txtRptStart] & " AND " &
Forms![frm_MAIN_MENU]![txtRptEnd]
'Old Code building dates on the fly and formatting them. Now using
values from form.
''Current Months Report
'strClaimDate = DateSerial(Year(Now()), Month(Now()), Day(Now()))
'strTitle = Format(strClaimDate, "mmmm yyyy") & " Claims as of " & _
' Format(DateSerial(Year(Now()), Month(Now()), Day(Now()) - 1),
"mm/dd/yy")
'Set up query being run.
'Note: This is just the value being passed and can likely be removed
Dim strExpName As String
strExpName = strQueryName
'-- Dump Query to Spreadsheet and Set Up Worksheetname Name for
Worksheet --
Dim strRngName As String
'strRngName = "All Records As Of Yesterday"
strRngName = strQueryName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strExpName,
strTemp, , strRngName
'Create an Excel Object, OPen Workbook for formatting and point it to
the Template Directory
Dim xlApp As Object
Set xlApp = CreateObject("EXCEL.APPLICATION")
Dim DataWB As Workbook
xlApp.Visible = True
Set DataWB = xlApp.Workbooks.Open(strTemp)
'-- Format Excel Worksheet
DataWB.Worksheets("DETAIL").Range("Create_Date").Value = "Report Created
: " & Format(Now, "mm/dd/yyyy")
DataWB.Worksheets("DETAIL").Range("Report_Title").Value = strTitle
'-- Save and Close Formatted Report, Exit Excel --
On Error Resume Next
Kill strFileName 'delete an existing version if it already exists
On Error GoTo 0
DataWB.SaveAs strFileName
DataWB.Close
xlApp.Quit
'-- Alert Report has been printed --
MsgBox "Your Report has been saved to " & strFileName
DoCmd.SetWarnings True
End Function
I run the following code from behind a command button in an Access database.
It produces the file fine, but when I open the file, I would like to
worksheet named 'SOURCE' to be hidden, and for the pivot table data to be
refreshed. Are there some lines of code I can add to make this happen?
Here is the code:
Option Compare Database
Option Explicit
Function CreateExcelReport(strQueryName As String) As Boolean
'Turn off any access warning and prompts
DoCmd.SetWarnings False
'Get current Database location.
'Used as a variable b/c individual drive mappings may vary
Dim db As DAO.Database, strPath As String, strDir As String
Set db = CurrentDb()
strPath = CurrentDb.Name
strDir = Left$(strPath, Len(strPath) - Len(Dir(strPath)) - 1) & "\"
'Set Report Export Path and File Name w/ last Sunday's date
Dim strReportPath, strFileName As String
strReportPath = strDir & "Report_Exports\"
strFileName = strReportPath & strQueryName & "_" &
Replace(Forms![frm_MAIN_MENU]![txtRptEnd], "/", "") & ".xls"
'Calculate Prior Sunday's Date = [Todays Date] -
(WhatDayInTheWeekIsToday) + 1 = LAST SUNDAY
'ie. Fri 10/24:
' Friday is 6th Day in the Week, Sunday is 1st Day in the
Week, so need to go back 5 days.
' [10/24] - (6)+ 1 = 10/19
'Dim strDate
'strDate = Date - Weekday(Date, vbSunday) + 1
'strFileName = strReportPath & "ReportTitle_" & Format(strDate,
"dddd mm-dd-yyyy") & ".xls"
'Path and FileName for TEMPLATE Files. Could use queryName in Template
FileName to permit
'using function with mulitple templates
Dim strTemp As String
strTemp = strReportPath & "doNotTouch_BLANK_TEMPLATE\" & strQueryName &
"_TEMP.xls"
'strTemp = strReportPath &
"doNotTouch_BLANK_TEMPLATE\AllRecordsAsOfYesterday_TEMP.xls"
'Get and Set String Values for Report Headings - Title, Run Dates, Eff
Dates, etc.
Dim strTitle, strClaimDate, strRunDate
strTitle = "Default Title"
'Build Report title using values on Main Form (frm_MAIN_MENU)
strTitle = "Acknowledgment Information on Quotes/Policies Created
Between " & _
Forms![frm_MAIN_MENU]![txtRptStart] & " AND " &
Forms![frm_MAIN_MENU]![txtRptEnd]
'Old Code building dates on the fly and formatting them. Now using
values from form.
''Current Months Report
'strClaimDate = DateSerial(Year(Now()), Month(Now()), Day(Now()))
'strTitle = Format(strClaimDate, "mmmm yyyy") & " Claims as of " & _
' Format(DateSerial(Year(Now()), Month(Now()), Day(Now()) - 1),
"mm/dd/yy")
'Set up query being run.
'Note: This is just the value being passed and can likely be removed
Dim strExpName As String
strExpName = strQueryName
'-- Dump Query to Spreadsheet and Set Up Worksheetname Name for
Worksheet --
Dim strRngName As String
'strRngName = "All Records As Of Yesterday"
strRngName = strQueryName
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strExpName,
strTemp, , strRngName
'Create an Excel Object, OPen Workbook for formatting and point it to
the Template Directory
Dim xlApp As Object
Set xlApp = CreateObject("EXCEL.APPLICATION")
Dim DataWB As Workbook
xlApp.Visible = True
Set DataWB = xlApp.Workbooks.Open(strTemp)
'-- Format Excel Worksheet
DataWB.Worksheets("DETAIL").Range("Create_Date").Value = "Report Created
: " & Format(Now, "mm/dd/yyyy")
DataWB.Worksheets("DETAIL").Range("Report_Title").Value = strTitle
'-- Save and Close Formatted Report, Exit Excel --
On Error Resume Next
Kill strFileName 'delete an existing version if it already exists
On Error GoTo 0
DataWB.SaveAs strFileName
DataWB.Close
xlApp.Quit
'-- Alert Report has been printed --
MsgBox "Your Report has been saved to " & strFileName
DoCmd.SetWarnings True
End Function