No, False just refers to whether to save the workbook or not
Function FileExists(FilePath As String) As Boolean
Dim TestStr As String
TestStr = ""
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
If TestStr = "" Then
FileExists = False
Else
FileExists = True
End If
End Function
Public Sub FileCopy(SrcPath As String, SrcName As String, DestName As String, Optional DestPath As String)
Dim fso As Object
If IsMissing(DestPath) Then
DestPath = SrcPath
End If
If FileExists(SrcPath & SrcName) = False Then
MsgBox ("Copy Cancelled - Source File Does Not Exist")
ElseIf FileExists(DestPath & DestName) = True Then
MsgBox ("Copy Cancelled - Destination File Already Exists")
Else
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
fso.CopyFile SrcPath & SrcName, DestPath & DestName
End If
End Sub
Function IsFileOpen(fileName As String)
Dim fileNum As Integer
Dim errNum As Integer
'Allow all errors to happen
On Error Resume Next
fileNum = FreeFile()
'Try to open and close the file for input. Errors mean the file is already open
Open fileName For Input Lock Read As #fileNum
Close fileNum
errNum = Err
'Do not allow errors to happen
On Error GoTo 0
'Check the Error Number
Select Case errNum
Case 0 'errNum = 0 means no errors, therefore file closed
IsFileOpen = False
Case 70 'errNum = 70 means the file is already open
IsFileOpen = True
Case Else 'Something else went wrong
IsFileOpen = errNum
End Select
End Function
Public Sub FormatList(Source As String, Template As String, SheetName As String)
On Error GoTo ErrHandler
'Coded using late binding so instances are defined as objects and excel specific types are enumerated
'Variable Definitions
Dim excelApp As Object
Dim wbSource As Object, wbTemplate As Object
Dim wsDestination As Object, wsSource As Object, wsTemplate As Object
Dim rngDestination As Object, rngTemplate As Object
Dim lastrow As Long, lastcol As Long
'Transfer data from export source to copy of template file
Set excelApp = CreateObject("Excel.Application")
excelApp.Application.Visible = True
Set wbSource = excelApp.Workbooks.Open(Source) 'Open Source workbook
Set wbTemplate = excelApp.Workbooks.Open(Template) 'Open Template copy
Set wsTemplate = wbTemplate.Worksheets(1) 'Set Template sheet
Set wsSource = wbSource.Sheets(1) 'Set source workbook sheet
wsSource.Copy after:=wbTemplate.Worksheets(wbTemplate.Worksheets.Count) 'Copy source worksheet to end of template copy
wbSource.Close
Set wsDestination = wbTemplate.Worksheets(wbTemplate.Worksheets.Count) 'Set New List Destination Sheet
lastrow = wsDestination.UsedRange.Rows.Count
lastcol = wsDestination.UsedRange.Columns.Count
Set rngDestination = wsDestination.Range(wsDestination.Cells(2, 1), wsDestination.Cells(lastrow, lastcol)) 'Set destination data range
Set rngTemplate = wsTemplate.Range(wsTemplate.Cells(2, 1), wsTemplate.Cells(lastrow, lastcol)) 'Set template data range
rngTemplate.Cells.Value = rngDestination.Cells.Value 'Set template data equal to destination data
wsDestination.Delete
'Format alternating row shading, column borders and column widths for new range of data
With rngTemplate
.Borders(11).LineStyle = 1
.FormatConditions.Delete
.FormatConditions.Add Type:=2, Formula1:="=MOD(ROW(),2)"
With .FormatConditions(1).Interior
.ColorIndex = 15
.TintAndShade = 0
End With
.Columns.AutoFit
End With
ExitHandler:
excelApp.Workbooks.Close
excelApp.Quit
Set excelApp = Nothing
Exit Sub
ErrHandler:
Call ErrProcessor
Resume ExitHandler
End Sub
Public Sub ExportQuery(QueryName As String, ExportPath As String, Optional expFileName As String)
On Error GoTo ErrHandler
ProcName = "ExportQuery"
If IsMissing(expFileName) Then
expFileName = QueryName
End If
DoCmd.TransferSpreadsheet _
TransferType:=acExport, _
SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=QueryName, _
fileName:=ExportPath & expFileName & ".xlsx"
ExitHandler:
'Insert any code that needs to come after error handler here
Exit Sub
ErrHandler:
Call ErrProcessor
Resume ExitHandler
End Sub
Private Sub btnExport_Click()
On Error GoTo ErrHandler
'Variable Definitions
Dim qryExport As String
Dim exportFileName As String, exportFilePath As String, exportFile As String
Dim templateFileName As String, templateFilePath As String, templatefile As String
Dim listFileName As String, listFilePath As String, listFile As String
Dim listArchivePath As String, listArchiveName As String, listArchive As String
Dim ShtName As String
Dim ProcCheck As Long
Dim fso As Object
Dim FileDate As String
ProcCheck = 0 'Each positive check increments
'Query Export Information
qryExport = "qryAvailability"
exportFileName = "qryAvailability"
exportFilePath = "**REDACTED**"
exportFile = exportFilePath & exportFileName
'Template Information
templateFileName = "UATemplate.xlsm"
templateFilePath = exportFilePath
templatefile = templateFilePath & templateFileName
'List Information
ShtName = "UNIT AVAILABILITY LIST"
listFileName = "UNIT AVAILABILITY LIST.xlsx"
listFilePath = "**REDACTED**"
listFile = listFilePath & listFileName
'Archive Information
listArchivePath = "**REDACTED**"
FileDate = Format(Now, "yyyy-mm-dd hh-mm-ss")
listArchiveName = Left(listFileName, Len(listFileName) - 5) & " " & FileDate & ".xlsx"
listArchive = listArchivePath & listArchiveName
If FileExists(exportFile) = False Then 'If export file already exists, query export will fail.
ProcCheck = ProcCheck + 1
Else
Dim answer As Boolean
answer = MsgBox("The exported file already exists. Do you want to delete it?" _
, vbQuestion + vbYesNo + vbDefaultButton2 _
, "WARNING: EXPORT FILE ALREADY EXISTS")
If answer = vbNo Then
MsgBox ("Ok. Aborting Export.")
Else
'Delete old export file if it exists
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile exportFile
Set fso = Nothing
ProcCheck = ProcCheck + 1
End If
End If
'Check If Current List Open
If IsFileOpen(listFile) = True Then
MsgBox ("Cannot export. Current list is in use.")
Else
ProcCheck = ProcCheck + 1
End If
If ProcCheck = 2 Then
'Rename old list and move to archive
'This step is first to minimize time between checking if this file is open and attempting to delete it
If FileExists(listFile) Then
Call FileCopy(listFilePath, listFileName, listArchiveName, listArchivePath)
If FileExists(listArchive) Then
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile listFile
Set fso = Nothing
End If
End If
'Export the query to an excel spreadsheet
Call ExportQuery(qryExport, exportFile, exportFileName)
'Copy the template file
Call FileCopy(templateFilePath, templateFileName, listFileName)
'Transfer data from export to new copy of the template
Call FormatList(exportFile, templatefile, ShtName)
'Delete the generated export file
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile exportFile
Set fso = Nothing
'Copy New List to List Location
Call FileCopy(templateFilePath, listFileName, listFileName, listFilePath)
'Acknowledgment Message
MsgBox ("Export Successful!")
End If
ExitHandler:
'needed code
Exit Sub
ErrHandler:
Call ErrProcessor
Resume ExitHandler
End Sub
Public Sub FileCopy(SrcPath As String, SrcName As String, DestName As String, Optional DestPath As String)
Dim fso As Object
If IsMissing(DestPath) Then
DestPath = SrcPath
End If
...More Code...
?I would have checked the length?
Were you addressing me? If so yes that's what I meant in post 80Don't you need an excelapp.quit
https://answers.microsoft.com/en-us...-running/4f37514f-b616-42ab-8bba-ef6010795689