我在下面的這個項目是一個參考卡,它從excel文件中提取文本,並從同一個搜索文件夾中獲取圖片。然後通過一個接一個地調用Subs來「循環」該過程直到該應用退出。通過研究文件並重復該過程,參考卡應該每10分鐘更新一次。問題是我想讓代碼打開文件,拉出,然後完全關閉文件,然後等待並重復。這樣該文件可以在下次更新之前進行編輯。相反,它表示它仍在使用,意思是隻讀。即使我關閉了應用程序和視覺工作室,它仍然表示仍在使用中。我必須在任務管理器中強制結束進程。Marshal.ReleaseComObject首次發佈
使用Marshal.ReleaseComObject
不起作用。代碼啓動Excel進程,通過代碼和發佈不起作用。在第二次循環並創建一個新進程(現在爲2個Excel進程)之後,該版本可以工作,但只適用於新進程而不是原始進程,並且每次循環都會繼續進行。 請幫忙我一整天都在主演。
下面的圖片是在第一次創建的過程和第一個失敗的對象發佈之後,在'releaseObject(wbXl)`第二次通過代碼之前。之後,第二個過程被釋放,但從未第一個等。請注意,如果應用程序關閉,則第一個過程會結束。
代碼
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