Duraholiday Duraholiday - 7 months ago 11
Vb.net Question

Excel workbook, folder and picture files not closing/ending completely

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

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

Option Explicit On
Imports System
Imports System.IO
Imports System.Text
Imports Excel = Microsoft.Office.Interop.Excel

Public Class Form1
Dim appXL As Excel.Application
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

End Sub

Private Sub Wait()
Threading.Thread.Sleep(600000)
ReferenceCardDataPull()
End Sub
Private Async Sub ReferenceCardDataPull()

'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
wbXl = appXL.Workbooks.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

'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
shXL = Nothing
wbXl.Close()
appXL.Quit()
appXL = Nothing
Else
lblCODE.Text = ("Error")
lblCODE.ForeColor = Color.Red
lblREV.Text = ("Error")
lblREV.ForeColor = Color.Red
lblDate.Text = ("Error")
lblDate.ForeColor = Color.Red
lblCustomer.Text = ("Error")
lblCustomer.ForeColor = Color.Red
lblPart.Text = ("Error")
lblPart.ForeColor = Color.Red
lblSpindleType.Text = ("Error")
lblSpindleType.ForeColor = Color.Red
lblPaintType.Text = ("Error")
lblPaintType.ForeColor = Color.Red
lblDunnageType.Text = ("Error")
lblDunnageType.ForeColor = Color.Red
Lable49.Text = ("Error")
Lable49.ForeColor = Color.Red
lblLayers.Text = ("Error")
lblLayers.ForeColor = Color.Red
lblTotalParts.Text = ("Error")
lblTotalParts.ForeColor = Color.Red
lblPackagingInstructs.Text = ("Error")
lblPackagingInstructs.ForeColor = Color.Red
lblError.Visible = True
End If
timeUpDate = 599
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 = "Updating"

End If

End Sub
End Class


Updated Code using
Marshal.objectrelease


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 wbXl As Excel.Workbook**** Archive
'Dim shXL As Excel.Worksheet**** Archive
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
Dim OpenFolder As Object = CreateObject("shell.application")


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

ehh ehh
Answer

Workink with COM in .Net requires to release com objects. More than that, you cannot use dots when working with excel interop (or any other COM object) in .Net since between the dots, temporarly objects are created behind the scene and need to be released. For example, you wrote:

appXL.Workbooks.Open

You need to split it to

Dim workbooks as Excel.Workbooks
workbooks = appXL.WorkBooks
workbooks.Open
...
When time to release, you need to call Marhsal.ReleaseComObject(workbooks).

You must do it for all the excel objects you have in the code. An example of the usage of excel in VB.Net:

Public Function PrintExcel(sPath As String, iFrom As Integer) As String Implements IPrint.PrintExcel
    Dim xlApp As Excel.Application = Nothing
    Dim xlWorkBooks As Excel.Workbooks = Nothing
    Dim xlWorkBook As Excel.Workbook = Nothing
    Dim xlWorkSheets As Excel.Sheets = Nothing
    Dim xlWorkSheet As Excel.Worksheet = Nothing

    Try
        xlApp = New Excel.Application
        xlWorkBooks = xlApp.Workbooks
        xlWorkBook = xlWorkBooks.Open(sPath)
        xlWorkSheets = xlWorkBook.Sheets
        xlWorkSheet = xlWorkSheets(1)

       ' DO SOMETHING

        xlWorkBook.Close()

        xlWorkBooks.Close()
        xlApp.Quit()

    Catch ex As Exception
    Finally
        releaseObject(xlWorkSheet)
        releaseObject(xlWorkSheets)
        releaseObject(xlWorkBook)
        releaseObject(xlWorkBooks)
        releaseObject(xlApp)


    End Try
    Return s
End Function

Private Sub releaseObject(ByVal obj As Object)
    Try
        If obj IsNot Nothing Then
            Marshal.ReleaseComObject(obj)
        End If

    Catch ex As Exception

    Finally
        obj = Nothing
    End Try
End Sub

' ----------------------

Following your code with the fix, not checked:

Option Explicit On
Imports System
Imports System.IO
Imports System.Text
Imports Excel = Microsoft.Office.Interop.Excel

Public Class Form1
  Dim appXL As Excel.Application
  Dim wbXls As Excel.Workbooks
  Dim wbXl As Excel.Workbook
  Dim shXLs As Excel.Sheets    ' FIX 1: Sheets instead of WorkSheets
  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(600000)
End Sub
Private Async Sub ReferenceCardDataPull()

    '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
        wbXls = appXL.Workbooks
        wbXl = wbXls.Open(FldPath & "\" & PartID & ".xlsm")
        shXLs = wbXl.Worksheets
        shXL = shXLs("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

        '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
                          ' FIX 2: remove shXL = Nothing
        wbXl.Close()
        wbXls.Close()
        appXL.Quit()
                          ' FIX 3: remove appXL = Nothing           
        releaseObject(shXL)
        releaseObject(shXLs)
        releaseObject(wbXl)
        releaseObject(wbXls)
        releaseObject(appXL)


    Else
        lblCODE.Text = ("Error")
        lblCODE.ForeColor = Color.Red
        lblREV.Text = ("Error")
        lblREV.ForeColor = Color.Red
        lblDate.Text = ("Error")
        lblDate.ForeColor = Color.Red
        lblCustomer.Text = ("Error")
        lblCustomer.ForeColor = Color.Red
        lblPart.Text = ("Error")
        lblPart.ForeColor = Color.Red
        lblSpindleType.Text = ("Error")
        lblSpindleType.ForeColor = Color.Red
        lblPaintType.Text = ("Error")
        lblPaintType.ForeColor = Color.Red
        lblDunnageType.Text = ("Error")
        lblDunnageType.ForeColor = Color.Red
        Lable49.Text = ("Error")
        Lable49.ForeColor = Color.Red
        lblLayers.Text = ("Error")
        lblLayers.ForeColor = Color.Red
        lblTotalParts.Text = ("Error")
        lblTotalParts.ForeColor = Color.Red
        lblPackagingInstructs.Text = ("Error")
        lblPackagingInstructs.ForeColor = Color.Red
        lblError.Visible = True
    End If
    timeUpDate = 599
    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 = "Updating"

    End If

End Sub

Private Sub releaseObject(ByVal obj As Object)
        Try
            If obj IsNot Nothing Then
                Marshal.ReleaseComObject(obj)
            End If

        Catch ex As Exception

        Finally
            obj = Nothing
        End Try
    End Sub

End Class