Private Sub cmdPortFolioOutput_Click()
On Error GoTo Errorhandler
DoCmd.SetWarnings False
Dim outputFileName As String
strOutputFileName = [Application].[CurrentProject].[Path] & "\DE_Data\Portfolio\OUT\PortFolioTemplate_" & DLookup("[CustomerFileName]", "1_CustomerProspectSelection") & "_" & DLookup("[LISTREFERENCE]", "LookupListRef") & ".xlsx"
DoCmd.OpenQuery "qry_PortFolioOutputCreated"
cboPortFolioOutput.Locked = True
PortFolioOutputCreated.Visible = True
cmdPortFolioImport.Visible = True
lblDataIn.Visible = True ' Show export DIR link
DoCmd.OpenQuery "qry_Portfolio_MainLive"
DoCmd.OpenQuery "qry_Portfolio_Clearance"
DoCmd.OpenQuery "qry_Portfolio_LimitedAvailability"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Portfolio_MainLive", strOutputFileName, True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Portfolio_LimitedAvailability", strOutputFileName, True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "Portfolio_Clearance", strOutputFileName, True
Dim xl As Object
Set xl = CreateObject("excel.application")
Dim wb As Object
Set wb = xl.Workbooks.Open(strOutputFileName)
Dim ws As Object
Set ws = wb.Worksheets("Portfolio_LimitedAvailability")
ws.Activate
Set ws = wb.Worksheets("Portfolio_MainLive")
ws.Activate
wb.Save
xl.ActiveWorkbook.Close 'close the workbook
xl.Quit 'quit the excel instance
''--------
MsgBox "Portfolio Template Created", vbInformation, "PortFolio Template"
Requery
DoCmd.SetWarnings True
Exit Sub
Errorhandler:
MsgBox "Error " & Err.Number & Err.Description
Exit Sub
End Sub