Marshal.ReleaseComObject不会为第一个实例发布

时间：2016-02-10 19:12:45

标签： vb.net excel object

我正在进行的这个项目是一个参考卡，它从excel文件中提取文本，并从同一个搜索文件夹中提取图片。然后通过逐个调用Subs来“循环​​”该过程，直到退出应用程序。参考卡应该通过研究文件并重复该过程每10分钟更新一次。问题是我希望代码打开文件，拉动，然后完全关闭文件然后等待并重复。这样可以在下次更新之前编辑文件。相反，它说它仍然在使用，这意味着只读。即使我关闭应用程序和视觉工作室，它仍然表示仍在使用。我必须在任务管理器中强制执行结束进程。

使用Marshal.ReleaseComObject无效。代码启动Excel Process，查看代码并发布不起作用。在第二次循环并创建一个新进程（现在2个Excel进程）之后，该版本可以正常工作，但仅适用于新进程而不是原始进程，并且每个循环都会继续。 请帮助我一整天都在主演。

下面的图片是在第一个创建的进程和第一个失败的对象发布之后以及第二次通过代码的'releaseObject（wbXl）之前。在此之后，第二个过程被释放，但从来没有第一个过程，依此类推。请注意，如果应用关闭，第一个流程会结束。

enter image description here

代码 

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

1 个答案:

答案 0 :(得分：0)

尝试修改代码以关闭excel而不是调用此函数：

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

此解决方案多次适用于我。我相信诀窍是你在调用Nothing函数后没有将Excel对象变量设置为ReleaseComObject。

相关问题
最新问题