Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Orphaned Excel.Exe Process....

Status
Not open for further replies.
lameid

lameid

Programmer
Jan 31, 2001
4,207
US
Subject about says it all, my procedure is leaving an orphaned Excel.exe process after the XL.Quit is hit. The only things I have found suggest making sure that any with statements are explicitly have the variable set to nothing and generally properly cleaning up objects. My eyes have gone to Krispy Kreme on this one (glazed over)... any insight much appreciated...

Even if I kill the problem Excel process, I still have to run the code again, stop it and ensure the process is not running for it to run again. Annoying when you are trying to post format an Excel document.

Code: 
Sub ExcelReport(ByRef frm As Form, lngReportID As Long, strFile As String)
    'On Error Goto ExcelReport_Err
    'Leaving an orphaned Excel.exe process...
    
    Dim strSQLSheet As String
    Dim db As DAO.Database
    Dim rsSheet As DAO.Recordset
    Dim rsSheetLayout As DAO.Recordset
    Dim qry As DAO.QueryDef
    Dim strSQLSPT As String
    Dim strSelectClause As String
    Dim XL As Excel.Application
    Dim XLBook As Excel.Workbook
    Dim XLSheet As Excel.Worksheet
    Dim XLRange As Excel.Range
    Dim XLBorder As Excel.Border
    Dim lngCol As Long
    Dim i As Integer
            
    Set db = CurrentDb()
    'Open Current ACE table for 'Report' / Workbook to be created
    Set rsSheet = db.OpenRecordset("Select SheetID, ReportID, SheetNumber, SheetName, ReportHeader, SourceProcedure, CriteriaField From Sheet Where ReportID = " & lngReportID & vbCrLf & "Order By ReportID, SheetNumber")
    
    While Not rsSheet.EOF
        
        'Lazy code to fix later to deal with dates
        If frm!chkDateFilter Then
            strSQLSPT = " '1/1/2012', '" & Now() & "'"
        Else 'YTD
            strSQLSPT = " '" & frm!txtBegin & "', '" & frm!txtEnd & "'"
        End If
        
        strSQLSPT = rsSheet!SourceProcedure & strSQLSPT
        'Addparameter concatenates a comma and parameter in... InjectionRisk test for nulls and does some other thins to lesson chance of SQL injection
        addParameter strSQLSPT, InjectionRisk(frm.Controls(rsSheet!CriteriaField).Value, True)
        
        'Change SQL property of existing Pass-through query...
        SetSQL "qrySPT MetricProc", strSQLSPT
        
        'Open another ACE table to build a query with report headers
        Set rsSheetLayout = db.OpenRecordset("Select * From SheetLayout Where SheetID = " & rsSheet!SheetID & vbCrLf & "Order By SheetID, Sequence")
                
        strSelectClause = ""
                
        While Not rsSheetLayout.EOF
            
            If Nz(rsSheetLayout!SecondColumnName, "") = "" Then
                'I do not have input on requirement <bangs head against wall>
                If rsSheetLayout!FirstColumnName = rsSheetLayout!GroupHeader Then
                    addParameter strSelectClause, "[" & Replace(rsSheetLayout!FirstColumnName, "#", "|hash|") & "]"
                Else
                    addParameter strSelectClause, "[" & rsSheetLayout!FirstColumnName & "] As [" & Replace(Replace(rsSheetLayout!GroupHeader, ".", "||"), "#", "|hash|") & "]"
                End If
            Else
                addParameter strSelectClause, "[" & rsSheetLayout!FirstColumnName & "] As [" & Replace(Replace(rsSheetLayout!GroupHeader & "|" & rsSheetLayout!FirstHeader, ".", "||"), "#", "|hash|") & "]"
            End If
            
            rsSheetLayout.MoveNext
        Wend
        
        Set qry = db.CreateQueryDef(rsSheet!SheetName, "Select " & strSelectClause & vbCrLf & "From [qrySPT MetricProc];")
        qry.Close
        
        'ACE query based on SPT query built with column aliases with desired sheet names...
        
        'Export Sheet
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, rsSheet!SheetName, strFile, True
        
        DoCmd.DeleteObject acQuery, rsSheet!SheetName
        
        rsSheet.MoveNext
    
    Wend
    
'Finally into Excel here...  A whole bunch of formatting
    Set XL = CreateObject("Excel.Application")
    Set XLBook = XL.Workbooks.Open(FileName:= _
               strFile)
    
    XL.DisplayAlerts = False
    
    XL.Visible = True
    For Each XLSheet In XLBook.Worksheets
        XLSheet.Activate
        Set XLRange = XLSheet.Rows(1)
        XLRange.RowHeight = 32.75
        XLRange.WrapText = True
        
        Set XLRange = XLSheet.Range("A1")
        Set XLRange = Range(XLRange, XLRange.SpecialCells(xlLastCell))
                
        For i = xlEdgeTop To xlInsideHorizontal Step 1 'Constants in Excel 2010 range 8 to 12 consecutively
            
            Set XLBorder = XLRange.Borders(i)
            With XLBorder
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            
        Next
        
        Set XLBorder = Nothing
        
        'Undo replacements in column headings
        XLRange.Replace What:="|hash|", Replacement:="#", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        XLRange.Replace What:="||", Replacement:=".", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        
        XLRange.EntireColumn.AutoFit
               
        
        Set XLRange = XLSheet.Rows(1)
        XLRange.Insert Shift:=xlDown
        XLRange.Insert Shift:=xlDown
        XLRange.Insert Shift:=xlDown
        'GoTo ContinueNext
        
        Set XLRange = XLSheet.Cells(2, 1)
        XLRange.WrapText = True
        XLRange.RowHeight = 32.75
        XLRange.ColumnWidth = 15
        
        
        Set XLRange = XLSheet.Cells(4, 1)
        
        Set XLRange = XLRange.End(xlToRight)
        
        
        lngCol = XLRange.Column
        
        Set XLRange = XLSheet.Range(XLSheet.Cells(2, 2), XLSheet.Cells(2, lngCol))
        
        With XLRange
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        XLRange.Merge
        
        Set XLRange = XLSheet.Range(XLSheet.Cells(3, 2), XLSheet.Cells(3, lngCol))
        With XLRange
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        XLRange.Merge
    
        Set XLRange = XLSheet.Range(XLSheet.Cells(2, 1), XLSheet.Cells(3, lngCol))
        XLRange.Borders(xlDiagonalDown).LineStyle = xlNone
        XLRange.Borders(xlDiagonalUp).LineStyle = xlNone
                
        For i = xlEdgeTop To xlInsideHorizontal Step 1 'Constants in Excel 2010 range 8 to 12 consecutively
            
            Set XLBorder = XLRange.Borders(i)
            With XLBorder
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            
        Next
        
        Set XLBorder = Nothing
        
        rsSheet.FindFirst ("SheetName = """ & XLSheet.Name & """")
        XLSheet.Cells(2, 1).FormulaR1C1 = rsSheet!ReportHeader
ContinueNext:
    Next
    
    XL.DisplayAlerts = True
    
    XL.Visible = True
    
    XLBook.Save
    
   
    
ExcelReport_Cleanup:
    
    Set qry = Nothing
    Set db = Nothing
    
    Set XLRange = Nothing
    
    Set XLSheet = Nothing
    
    If Not (XLBook Is Nothing) Then
        XLBook.Close False
        Set XLBook = Nothing
    End If
    
    If Not (rsSheetLayout Is Nothing) Then
        Set rsSheetLayout = Nothing
    End If
    
    If Not (rsSheet Is Nothing) Then
        Set rsSheet = Nothing
    End If
    
    If Not (XL Is Nothing) Then
        XL.Quit 'Breakpoint here shows Excel is made not visible after execution but can be made visible in immediate window
        Set XL = Nothing
    End If
    
    

Exit Sub
ExcelReport_Err:

    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & "Error occured in ExcelReport", vbCritical, "Error in ExcelReport"
    Resume ExcelReport_Cleanup

End Sub
 
Sort by date Sort by votes
Wow... Always as soon as you ask you run across something and the lightbulb goes off...


In short ALL Excel Methods etc. have to be made relateive to a declared object associated with the declared application...

The piece I was missing in red below...

Code: 
Set XLRange = XLSheet.Range("A1")
Set XLRange = [red]XLSheet.[/red]Range(XLRange, XLRange.SpecialCells(xlLastCell))

I wish it just would have failed to compile instead.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

RolandR
  • Locked
  • Question
Winword AND Excel process still running after Quit and set to Nothing
Replies
6
Views
179
RolandR
RolandR
patriciaxxx
  • Locked
  • Question
Start single process in vba 1
2
Replies
20
Views
200
1DMF
1DMF
teach314
  • Locked
  • Question
How to delete an orphaned entry in ObjectBrowser/Classes
Replies
3
Views
30
teach314
teach314
Pack10
  • Locked
  • Question
How do you get the value stored in a field object while processing a table. ( i have the field name) 1
Replies
4
Views
35
dhookom
dhookom
radder33
  • Locked
  • Question
Loop a process
Replies
12
Views
51
radder33
radder33

Part and Inventory Search

Sponsor

Back
Top