[AccessD] Excel Not Closing

[Rocky Smolin]

Yes, that’s pretty much what I’m doing exiting the data export to the
spreadsheet. The only difference is that I am not opening an existing
spreadsheet, I am creating a new spreadsheet.

Tks

R

On Mon, Apr 10, 2023 at 11:05 AM Stephen Bateman <
stephenb at highimpactsolutions.com> wrote:

> 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
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> https://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>