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 calli
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