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