Which Export to Excel Process is best to copy data into an existing formatted spreadsheet? (1 Viewer)

[Minty]

@Isaac isn't that because of this line
wb.Close False
?

 

[Isaac]

@Isaac isn't that because of this line
wb.Close False
?

No, False just refers to whether to save the workbook or not

 

[Gasman]

Don't you need an excelapp.quit
https://answers.microsoft.com/en-us...-running/4f37514f-b616-42ab-8bba-ef6010795689

 

[JMongi]

How do you all go about testing the various scenarios this code is supposed to cover? How do you keep yourself organized?

At this point, the export code works (worked).
So, what I have to test is the various safety/error checks that got added to the code like missing files or files that should have been deleted. Here's the function/subs:

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

 

[JMongi]

Here is the main code for exporting:

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

 

[JMongi]

I've run into my first issue. The following code isn't working as I thought it would. I'm not passing an optional argument to my sub and want to set it to be one of the other passed arguments. However, when I debug.print on DestPath after the If/Then statement it is still empty. Debug.Print on SrcPath displays correctly.

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...

 

[JMongi]

Answer: certain variable types don't have a "missing" flag. Changed to As Variant and its working now.

 

[Gasman]

I would have checked the length?

 

[JMongi]

I would have checked the length?

?

 

[Isaac]

Don't you need an excelapp.quit
https://answers.microsoft.com/en-us...-running/4f37514f-b616-42ab-8bba-ef6010795689

Were you addressing me? If so yes that's what I meant in post 80