Question

我正在进行的这个项目是一个参考卡，它从excel文件中提取文本，并从同一个搜索文件夹中提取图片。然后通过逐个调用Subs来“循环”该过程，直到退出应用程序。参考卡应该通过研究文件并重复该过程每10分钟更新一次。问题是我希望代码打开文件，拉动，然后完全关闭文件然后等待并重复。这样可以在下次更新之前编辑文件。相反，它说它仍然在使用，这意味着只读。即使我关闭应用程序和视觉工作室，它仍然表示仍在使用。使用Marshal.ObjectRelease无效。代码启动Excel Process，查看代码并发布不起作用。在它循环第二次并创建一个新进程（现在2个Excel进程）后，该版本可以工作，但只适用于新进程而不是原始进程，并且每个循环都会继续。

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

使用 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

Answer 1

.Net中的COM的Workink需要释放com对象。更重要的是，在.Net中使用excel互操作（或任何其他COM对象）时不能使用点，因为在点之间，临时对象是在场景后面创建的，需要释放。例如，您写道：

appXL.Workbooks.Open

您需要将其拆分为

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

您必须对代码中的所有excel对象执行此操作。在VB.Net中使用excel的一个例子：

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

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

使用修复程序执行代码后，未选中：

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

结束班

Excel工作簿，文件夹和图片文件未完全关闭/结束

1 个答案: