CODEWITHSUNDEEP
vb.netexcelobject
Duraholiday
Duraholiday

Reputation: 111

Marshal.ReleaseComObject not releasing for first instance

This project I am working on below is a reference card that pulls text from an excel file and pictures from the same searched folder. The process is then "looped" by calling the Subs one after another until the app is exited. The reference card is supposed to update every 10 minute by researching for the files and repeating the process. The issue is that I wanted the code to open the file, pull, and then close the file completely then wait and repeat. This way the file could be edited before the next update. Instead it says it is still in use, meaning read only. Even when I close the app and visual studios it still says still in use. I have to force end process in the task manager.

Using Marshal.ReleaseComObject isn't working. The code starts the Excel Process, goes through out the code and release does not work. After it loops through the 2nd time and creates a new process (Now 2 Excel Processes) The release works but only for the new process not the original and this continues for each loop through. Please Help Ive been starring at this all day.

The picture below is after the first created process and the first failed object release and right before 'releaseObject(wbXl)` the second time through the code. After this the second process is released but never the first and so on. NOTE that the first process does end if the app is closed.

enter image description here

Code

Imports System
Imports System.IO
Imports System.Text
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel
Imports System.ComponentModel

Public Class Form1
Dim appXL As Excel.Application
Dim wbXls As Excel.Workbooks
Dim wbXl As Excel.Workbook
Dim shXL As Excel.Worksheet
Dim FldPath As String
Dim PartID As String
Dim RefCard As String
Dim timeUpDate As Double

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
    'Dispaly Brembo Logo
    picLogo.SizeMode = PictureBoxSizeMode.StretchImage
    ReferenceCardDataPull()
End Sub

Private Sub Wait()
    Threading.Thread.Sleep(10000)
End Sub
Private Async Sub ReferenceCardDataPull()
    'Prepare For Load
    lblTimer.Text = "Updating"
    lblError.Visible = False

    'Read File Source with part number ******************
    PartID = ("19.N111.10")


    ' Start Excel and get Application object.
    appXL = CreateObject("Excel.Application")
    appXL.Visible = False

    'Open Reference Card*************************************************************************************
    FldPath = ("\\HOMESHARE01\Public\Kaizens\Kaizen 44 - Missing Parts\Reference Cards\Completed Reference Cards by Part Number" & "\" & PartID)
    If System.IO.Directory.Exists(FldPath) Then

        If System.IO.File.Exists(FldPath & "\" & PartID & ".xlsm") Then
            'wbXl = appXL.Workbooks.Open(FldPath & "\" & PartID & ".xlsm")**** Archive

            wbXls = appXL.Workbooks
            wbXl = wbXls.Open(FldPath & "\" & PartID & ".xlsm")
            shXL = wbXl.Worksheets("Sheet1")

            ' Copys Reference Card Data by Cell To App labels
            lblCODE.Text = shXL.Cells(6, 5).Value
            lblREV.Text = shXL.Cells(3, 5).Value
            lblDate.Text = shXL.Cells(9, 5).Value
            lblCustomer.Text = shXL.Cells(3, 1).Value
            lblPart.Text = shXL.Cells(6, 1).Value
            lblSpindleType.Text = shXL.Cells(9, 1).Value
            lblPaintType.Text = shXL.Cells(12, 1).Value
            lblDunnageType.Text = shXL.Cells(15, 1).Value
            lblPartsLayer.Text = shXL.Cells(3, 3).Value
            lblLayers.Text = shXL.Cells(6, 3).Value
            lblTotalParts.Text = shXL.Cells(9, 3).Value
            lblPackagingInstructs.Text = shXL.Cells(12, 3).Value
        Else
            lblCODE.Text = ("Error")
            lblREV.Text = ("Error")
            lblDate.Text = ("Error")
            lblCustomer.Text = ("Error")
            lblPart.Text = ("Error")
            lblSpindleType.Text = ("Error")
            lblPaintType.Text = ("Error")
            lblDunnageType.Text = ("Error")
            Lable49.Text = ("Error")
            lblLayers.Text = ("Error")
            lblTotalParts.Text = ("Error")
            lblPackagingInstructs.Text = ("Error")
            lblError.Visible = True

            ' Close objects**** Archive
            ' shXL = Nothing**** Archive
            ' wbXl.Close()**** Archive
            'appXL.Quit()**** Archive
            'appXL = Nothing**** Archive



        End If

    Else
        'File not found Error
        lblCODE.Text = ("Error")
        lblREV.Text = ("Error")
        lblDate.Text = ("Error")
        lblCustomer.Text = ("Error")
        lblPart.Text = ("Error")
        lblSpindleType.Text = ("Error")
        lblPaintType.Text = ("Error")
        lblDunnageType.Text = ("Error")
        Lable49.Text = ("Error")
        lblLayers.Text = ("Error")
        lblTotalParts.Text = ("Error")
        lblPackagingInstructs.Text = ("Error")
        lblError.Visible = True
    End If

    'Pulls pictures from designated part folder
    If System.IO.File.Exists(FldPath & "\" & "PicSpindle" & PartID & ".JPG") Then
        picSpindle.Image = Image.FromFile(FldPath & "\" & "PicSpindle" & PartID & ".JPG")
        picSpindle.SizeMode = PictureBoxSizeMode.StretchImage
    Else
        picSpindle.SizeMode = PictureBoxSizeMode.StretchImage
    End If

    If System.IO.File.Exists(FldPath & "\" & "PicRotorTop" & PartID & ".JPG") Then
        picRotorTop.Image = Image.FromFile(FldPath & "\" & "PicRotorTop" & PartID & ".JPG")
        picRotorTop.SizeMode = PictureBoxSizeMode.StretchImage
    Else
        picRotorTop.SizeMode = PictureBoxSizeMode.StretchImage
    End If

    If System.IO.File.Exists(FldPath & "\" & "PicRotorBottom" & PartID & ".JPG") Then
        picRotorBottom.Image = Image.FromFile(FldPath & "\" & "PicRotorBottom" & PartID & ".JPG")
        picRotorBottom.SizeMode = PictureBoxSizeMode.StretchImage
    Else
        picRotorBottom.SizeMode = PictureBoxSizeMode.StretchImage
    End If

    If System.IO.File.Exists(FldPath & "\" & "PicDunnageFinal" & PartID & ".JPG") Then
        picDunnageFinal.Image = Image.FromFile(FldPath & "\" & "PicDunnageFinal" & PartID & ".JPG")
        picDunnageFinal.SizeMode = PictureBoxSizeMode.StretchImage
    Else
        picDunnageFinal.SizeMode = PictureBoxSizeMode.StretchImage
    End If

    If System.IO.File.Exists(FldPath & "\" & "PicDunnageLayer" & PartID & ".JPG") Then
        picDunnageLayer.Image = Image.FromFile(FldPath & "\" & "PicDunnageLayer" & PartID & ".JPG")
        picDunnageLayer.SizeMode = PictureBoxSizeMode.StretchImage
    Else
        picDunnageLayer.SizeMode = PictureBoxSizeMode.StretchImage
    End If

    ' Close objects
    wbXl.Close()
    wbXls.Close()
    appXL.Quit()
    'Release Objects
    releaseObject(shXL)
    releaseObject(wbXl)
    releaseObject(wbXl)
    releaseObject(wbXls)
    releaseObject(appXL)

    timeUpDate = 9
    tmrUpdate.Start()
    Application.DoEvents()
    Await Task.Run(Sub()
                       Wait()

                   End Sub)
    ReferenceCardDataPull()
End Sub

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles tmrUpdate.Tick
    Dim hms = TimeSpan.FromSeconds(timeUpDate)
    Dim m = hms.Minutes.ToString
    Dim s = hms.Seconds.ToString

    If timeUpDate > 0 Then
        timeUpDate -= 1
        lblTimer.Text = (m & ":" & s)

    Else

        tmrUpdate.Stop()
        lblTimer.Text = "Preparing Update"

    End If

End Sub
Private Sub releaseObject(ByVal obj As Object)
    Try
        Dim intRel As Integer = 0
        Do
            intRel = System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
        Loop While intRel > 0
        'MsgBox("Final Released obj # " & intRel)
    Catch ex As Exception
        MsgBox("Error releasing object" & ex.ToString)
        obj = Nothing
    Finally
        GC.Collect()
    End Try
End Sub
End Class

Upvotes: 0

Views: 932

Answers (1)

RianBattle
RianBattle

Reputation: 898

Try modifying your code to close excel to instead call this function:

Private Sub CloseExcel(ByRef xlApp As Excel.Application, xlWorkBook As Excel.Workbook, xlWorkSheet As Excel.Worksheet)
    Try
        xlWorkBook.Close()
    Catch ex As Exception
    End Try
    Try
        xlApp.Quit()
    Catch ex As Exception
    End Try
    Try
        releaseObject(xlApp)
    Catch ex As Exception
    End Try
    Try
        releaseObject(xlWorkBook)
    Catch ex As Exception
    End Try
    Try
        releaseObject(xlWorkSheet)
    Catch ex As Exception
    End Try
End Sub

Private Sub releaseObject(ByVal obj As Object)
    Try
        System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
        obj = Nothing
    Catch ex As Exception
        obj = Nothing
    Finally
        GC.Collect()
    End Try
End Sub

This solution has worked for me on multiple occasions. I believe the trick is that you are not setting your Excel object variables to Nothing after calling the ReleaseComObject function.

Upvotes: 1

Related Questions