2016-02-10 48 views
0

我在下面的這個項目是一個參考卡,它從excel文件中提取文本,並從同一個搜索文件夾中獲取圖片。然後通過一個接一個地調用Subs來「循環​​」該過程直到該應用退出。通過研究文件並重復該過程,參考卡應該每10分鐘更新一次。問題是我想讓代碼打開文件,拉出,然後完全關閉文件,然後等待並重復。這樣該文件可以在下次更新之前進行編輯。相反,它表示它仍在使用,意思是隻讀。即使我關閉了應用程序和視覺工作室,它仍然表示仍在使用中。我必須在任務管理器中強制結束進程。Marshal.ReleaseComObject首次發佈

使用Marshal.ReleaseComObject不起作用。代碼啓動Excel進程,通過代碼和發佈不起作用。在第二次循環並創建一個新進程(現在爲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 

回答

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 

該解決方案爲我工作在多個場合。我相信訣竅是您在調用ReleaseComObject函數後沒有將Excel對象變量設置爲Nothing

相關問題