Function ExportExpenseReport(sTabs As String, sParticipant As String, rptMo As Date, StartDate As Date, RanNextMonth As Boolean, ByVal Periods As Variant) As String
Dim RptFolder As String: RptFolder = ExportFolder & "Monthly Expenses " & Format(rptMo, "m-yyyy") & "-" & gRun
Dim RptName As String: RptName = "Expense Report " & sParticipant & "_" & sTabs & "_" & Format(rptMo, "yyyy-m") & "-" & gRun
Dim ZipFileName As String: ZipFileName = RptFolder & "\" & RptName & ".zip"
Dim ShellApp As Object
Dim ws As Worksheet
Dim NewWB As Workbook
Dim N As Name
Dim t As Long
Dim tCount As Long
Dim wsArray() As String
On Error GoTo ErrorExit
'Calculate Period Count
If RanNextMonth = True Then
tCount = UBound(Periods) - 1
Else
tCount = UBound(Periods)
End If
'Store Global
SpecificExportPath = RptFolder
'Create Folder (if not exists)
Call MakeMyFolder(RptFolder)
'Export Worksheets to New Book
wsArray = GetWSArray(tCount, RanNextMonth)
Worksheets(wsArray).Copy
Set NewWB = ActiveWorkbook
'Rename Worksheets
For Each ws In ActiveWorkbook.Worksheets
If InStr(ws.Name, "Month") > 0 Then
ws.Name = Replace(ws.Name, "Expenses Template", "")
ws.Name = Replace(ws.Name, "Next Month ", Format(ws.Range("H6"), "m-yyyy") & " ")
Else
ws.Name = Replace(ws.Name, " Template", "")
End If
Next ws
'Rename T Templates
For t = tCount To 1 Step -1
Worksheets("T" & t).Name = Format(CDate(Periods(t)), "m-yyyy")
Next t
'Clear Named Ranges
For Each N In NewWB.Names
If Left(N.Name, 1) <> "_" Then
N.Delete
End If
Next
'Save As and Close
NewWB.SaveAs fileName:=RptFolder & "\" & RptName, FileFormat:=51
NewWB.Close
'Create a Shell Application to zip the Excel file
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(ZipFileName).CopyHere CreateObject("Scripting.FileSystemObject").GetFile(RptFolder & "\" & RptName)
'Wait for the compression process to finish
Application.Wait Now + TimeValue("00:00:03")
ThisWorkbook.Activate
ExportExpenseReport = RptFolder & "\" & RptName
'Clean Exit
Exit Function
ErrorExit:
NewWB.Close SaveChanges:=False
ExportExpenseReport = "Error - Invalid File name: " & RptName
End Function
