[AccessD] Excel Not Closing

[Stephen Bateman]

I use this function from Christos Samaras at http://www.myengineeringworld.net

Attribute VB_Name = "modExportToExcel"
Option Compare Database
Option Explicit

Sub TestDataToExcel()
Dim strWkbPath As String
Dim strSource As String
Dim strSheet As String

    'Change the names according to your own needs.
    strWkbPath = "Destinaion path and File Name"
    strSource = Table or Query
    strSheet = Sheet Tab Name
    
    DataToExcel strSource, strWkbPath, strSheet
                
    'Just showing that the operation finished.
    MsgBox "Data export finished successfully!", vbInformation, "Done"
    
End Sub

 Function DataToExcel(ByVal strSourceName As String, Optional ByVal strWorkbookPath As String, Optional ByVal strTargetSheetName As String, _
                        Optional ByVal blnDisplay As Boolean) As Boolean
 
    'Use this function to export a large table/query from your database to a new Excel workbook.
    'You can also specify the name of the worksheet target.
    
    'strSourceName is the name of the table/query you want to export to Excel.
    'strWorkbookPath is the path of the workbook you want to export the data.
    'strTargetSheetName is the desired name of the target sheet.
    
    'By Christos Samaras
    'http://www.myengineeringworld.net
   
    Dim rst As DAO.Recordset
    Dim excelApp As New Excel.Application
    Dim Wbk As Excel.Workbook
    Dim sht As Excel.Worksheet
    Dim fldHeadings As DAO.Field
    Dim blnShowApp As Boolean
    Dim lCount As Long
    Dim FileName As String
    
'    On Error GoTo Errorhandler
     On Error Resume Next
     
    DataToExcel = False
    
    FileName = right(strWorkbookPath, Len(strWorkbookPath) - InStrRev(strWorkbookPath, "\"))
'Set the desired recordset (table/query).
    Set rst = CurrentDb.OpenRecordset(strSourceName)
    If Not rst.EOF Then
        rst.MoveLast
        rst.MoveFirst
        lCount = rst.RecordCount
        If lCount = 0 Then Exit Function
    Else
        DataToExcel = False
        Exit Function
    End If
    
    If IsNull(blnDisplay) Then
        blnShowApp = False
    Else
        blnShowApp = blnDisplay
    End If
    
    If FileExists(strWorkbookPath) Then
        If MsgBox("Overwrite existing file?" & vbCrLf & FileName, vbYesNo, "WARNING") = vbNo Then
            DataToExcel = False
            Exit Function
        Else
            Kill strWorkbookPath
        End If
    End If

    'Create a new Excel instance.
    Set excelApp = CreateObject("Excel.Application")
    excelApp.DisplayAlerts = False
'    On Error Resume Next
    
    'Try to open the specified workbook. If there is no workbook specified
    '(or if it cannot be opened) create a new one and rename the target sheet.
    If FileExists(strWorkbookPath) Then
        Set Wbk = excelApp.Workbooks.Open(strWorkbookPath)
    Else
'    If Err.Number <> 0 Or Len(strWorkbookPath) = 0 Then
        Set Wbk = excelApp.Workbooks.Add
        If Len(strTargetSheetName) > 0 Then
            Set sht = Wbk.Worksheets("Sheet1")
            sht.Name = Left(strTargetSheetName, 34)
        Else
            Set sht = Wbk.Worksheets("Sheet1")
        End If
    End If
    
    'If the specified workbook has been opened correctly, then in order to avoid
    'problems with other sheets that might contain, a new sheet is added and is
    'being renamed according to the strTargetSheetName.
    
    Set sht = Wbk.Worksheets.Add
    If Len(strTargetSheetName) > 0 Then
        sht.Name = Left(strTargetSheetName, 34)
    End If

    On Error GoTo 0
    
    Wbk.Save
    
    excelApp.Visible = blnShowApp

    'Write the headings in the target sheet.
    For Each fldHeadings In rst.Fields
        excelApp.ActiveCell = fldHeadings.Name
        excelApp.ActiveCell.offset(0, 1).Select
    Next
    
    'Copy the data in the target sheet.
        rst.MoveFirst
        sht.Range("A2").CopyFromRecordset rst
        sht.Range("1:1").Select

    'Format the headings of the target sheet.
    excelApp.Selection.Font.Bold = True
    With excelApp.Selection
        .HorizontalAlignment = -4108 '= xlCenter in Excel.
        .VerticalAlignment = -4108  '= xlCenter in Excel.
        .WrapText = False
        With .Font
            .Name = "Arial"
            .Size = 11
        End With
    End With
    
    'Adjusting the columns width.
    excelApp.ActiveSheet.Cells.EntireColumn.AutoFit
    
    'Freeze the first row - headings.
    With excelApp.ActiveWindow
        .FreezePanes = False
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    sht.Rows("2:2").Select
    excelApp.ActiveWindow.FreezePanes = True
    
    'Change the tab color of the target sheet.
    With sht
        .Tab.Color = RGB(255, 0, 0)
        .Range("A1").Select
    End With

    'Close the recordset.
    rst.Close
        
TempVars!ExcelPath = strWorkbookPath
Wbk.SaveAs (strWorkbookPath)
DoEvents

If blnShowApp = False Then excelApp.Quit

DataToExcel = True


ExitHandler:
    Set fldHeadings = Nothing
    Set excelApp = Nothing
    Set Wbk = Nothing
    Set sht = Nothing
    Set rst = Nothing
    Exit Function

ErrorHandler:
    DoCmd.Hourglass False
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume ExitHandler

End Function

Stephen Bateman

-----Original Message-----
From: AccessD <accessd-bounces+stephenb=highimpactsolutions.com at databaseadvisors.com> On Behalf Of Rocky Smolin
Sent: Monday, April 10, 2023 12:55 PM
To: Access Developers discussion and problem solving <accessd at databaseadvisors.com>
Subject: [AccessD] Excel Not Closing

Dear List:

I have an app which exports data to an Excel spreadsheet.  It is not amenable to using TransferSpreadsheet because of formatting problems, etc.
So I use the brute force method and it works well.

Problem is that at the end of the process the user wants the app to open the spreadsheet.

So I use Application.FollowHyperlink strFileName. Problem is that the spreadsheet opens blank.

When I go to the folder and open the spreadsheet it's there, all perfect.
So I put a breakpoint in at the statement Application.FollowHyperlink strFileName and looked at the Task Manager and sure enough there was an instance of Microsoft Excel still there in the list of background processes.

If I end that Excel process and then let the app execute the Follow Hyperlink it opens just fine. So it's that leftover instance of Excel that's hosing up the works.

 I set the objects like so:

Set objXLApp = New Excel.Application
Set objXLBook = objXLApp.Workbooks.Add
Set objXLWS = objXLBook.Sheets(1)

and at the end close up like so:

objXLBook.SaveAs strFileName
objXLBook.Close True

Set objXLWS = Nothing
Set objXLBook = Nothing

objXLApp.Quit
Set objXLApp = Nothing

How do I get rid of that instance of Excel in the background processes?


MTIA

Rocky
--
AccessD mailing list
AccessD at databaseadvisors.com
https://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com