我有一个小问题,我似乎不能弄清楚。我保存一个DataGridView(它的内容)到一个xls文件。我这样做没有问题,除了在我的任务管理器中它仍然显示它正在运行。
xlApp.Application.Quit()
声明为:
Dim xlApp As New excel.Application
这似乎不工作,但这是相同的方式,我退出当我让用户选择导出到Word文档。我不知道我哪里出错了……
这是我的完整代码
Imports Word = Microsoft.Office.Interop.Word
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For x As Integer = 1 To 3500
DataGridView1.Rows.Add(New Object() {"r" & x.ToString & "c1", "r" & x.ToString & "c2", "r" & x.ToString & "c3", "r" & x.ToString & "c4", "r" & x.ToString & "c5"})
Next
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
exportToWord (DataGridView1)
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim xlApp As New Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
'Dim misValue As Object = System.Reflection.Missing.Value
xlWorkBook = xlApp.Workbooks.Add
xlWorkSheet = DirectCast(xlWorkBook.Sheets("sheet1"), Excel.Worksheet)
xlApp.Visible = True
Dim headers = (From ch In DataGridView1.Columns _
Let header = DirectCast(DirectCast(ch, DataGridViewColumn).HeaderCell, DataGridViewColumnHeaderCell) _
Select header.Value).ToArray()
Dim headerText() As String = Array.ConvertAll(headers, Function(v) v.ToString)
Dim items() = (From r In DataGridView1.Rows _
Let row = DirectCast(r, DataGridViewRow) _
Where Not row.IsNewRow _
Select (From cell In row.Cells _
Let c = DirectCast(cell, DataGridViewCell) _
Select c.Value).ToArray()).ToArray()
Dim table As String = String.Join(vbTab, headerText) & Environment.NewLine
For Each a In items
Dim t() As String = Array.ConvertAll(a, Function(v) v.ToString)
table &= String.Join(vbTab, t) & Environment.NewLine
Next
table = table.TrimEnd(CChar(Environment.NewLine))
Clipboard.SetText (table)
Dim alphabet() As Char = "abcdefghijklmnopqrstuvwxyz".ToUpper.ToCharArray
Dim range As excel.Range = xlWorkSheet.Range("B2:" & alphabet(headerText.Length) & (items.Length + 2).ToString)
range.Select()
xlWorkSheet.Paste()
range.Borders(Excel.XlBordersIndex.xlDiagonalDown).LineStyle = Excel.XlLineStyle.xlLineStyleNone
range.Borders(Excel.XlBordersIndex.xlDiagonalUp).LineStyle = Excel.XlLineStyle.xlLineStyleNone
With range.Borders(Excel.XlBordersIndex.xlEdgeLeft)
.LineStyle = Excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = Excel.XlBorderWeight.xlMedium
End With
With range.Borders(Excel.XlBordersIndex.xlEdgeTop)
.LineStyle = Excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = Excel.XlBorderWeight.xlMedium
End With
With range.Borders(Excel.XlBordersIndex.xlEdgeBottom)
.LineStyle = Excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = Excel.XlBorderWeight.xlMedium
End With
With range.Borders(Excel.XlBordersIndex.xlEdgeRight)
.LineStyle = Excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = Excel.XlBorderWeight.xlMedium
End With
With range.Borders(Excel.XlBordersIndex.xlInsideVertical)
.LineStyle = Excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = Excel.XlBorderWeight.xlThin
End With
With range.Borders(Excel.XlBordersIndex.xlInsideHorizontal)
.LineStyle = Excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = Excel.XlBorderWeight.xlThin
End With
'xlApp.Visible = True
xlWorkBook.SaveAs("C:UsersCoDeXeRDesktopWord1.xls", True)
xlWorkBook.Close()
xlApp.Application.Quit()
ReleaseObject(xlWorkSheet) '<~~~ Added as per comment from deleted post
ReleaseObject (xlWorkBook)
ReleaseObject (xlApp)
End Sub
Public Sub exportToWord(ByVal dgv As DataGridView)
' Create Word Application
Dim oWord As Word.Application = DirectCast(CreateObject("Word.Application"), Word.Application)
' Create new word document
Dim oDoc As Word.Document = oWord.Documents.Add()
Dim headers = (From ch In dgv.Columns _
Let header = DirectCast(DirectCast(ch, DataGridViewColumn).HeaderCell, DataGridViewColumnHeaderCell) _
Select header.Value).ToArray()
Dim headerText() As String = Array.ConvertAll(headers, Function(v) v.ToString)
Dim items() = (From r In dgv.Rows _
Let row = DirectCast(r, DataGridViewRow) _
Where Not row.IsNewRow _
Select (From cell In row.Cells _
Let c = DirectCast(cell, DataGridViewCell) _
Select c.Value).ToArray()).ToArray()
Dim table As String = String.Join(vbTab, headerText) & Environment.NewLine
For Each a In items
Dim t() As String = Array.ConvertAll(a, Function(v) v.ToString)
table &= String.Join(vbTab, t) & Environment.NewLine
Next
table = table.TrimEnd(CChar(Environment.NewLine))
Clipboard.SetText (table)
Dim oTable As Word.Table = oDoc.Tables.Add(oDoc.Bookmarks.Item("endofdoc").Range, items.Count + 1, headers.Count)
oTable.Range.Paste()
'make the first row bold, fs 14 + change textcolor
oTable.Rows.Item(1).range.Font.Bold = &H98967E
oTable.Rows.Item(1).range.Font.Size = 14
oTable.Rows.Item(1).range.Font.Color = Word.WdColor.wdColorWhite
'change backcolor of first row
oTable.Rows.Item(1).range.Shading.Texture = Word.WdTextureIndex.wdTextureNone
oTable.Rows.Item(1).range.Shading.ForegroundPatternColor = Word.WdColor.wdColorAutomatic
oTable.Rows.Item(1).range.Shading.BackgroundPatternColor = Word.WdColor.wdColorLightBlue
''set table borders
'With oTable.Range.Tables(1)
' With .Borders(Word.WdBorderType.wdBorderLeft)
' .LineStyle = Word.WdLineStyle.wdLineStyleSingle
' .LineWidth = Word.WdLineWidth.wdLineWidth100pt
' .Color = Word.WdColor.wdColorAutomatic
' End With
' With .Borders(Word.WdBorderType.wdBorderRight)
' .LineStyle = Word.WdLineStyle.wdLineStyleSingle
' .LineWidth = Word.WdLineWidth.wdLineWidth100pt
' .Color = Word.WdColor.wdColorAutomatic
' End With
' With .Borders(Word.WdBorderType.wdBorderTop)
' .LineStyle = Word.WdLineStyle.wdLineStyleSingle
' .LineWidth = Word.WdLineWidth.wdLineWidth100pt
' .Color = Word.WdColor.wdColorAutomatic
' End With
' With .Borders(Word.WdBorderType.wdBorderBottom)
' .LineStyle = Word.WdLineStyle.wdLineStyleSingle
' .LineWidth = Word.WdLineWidth.wdLineWidth100pt
' .Color = Word.WdColor.wdColorAutomatic
' End With
' With .Borders(Word.WdBorderType.wdBorderHorizontal)
' .LineStyle = Word.WdLineStyle.wdLineStyleSingle
' .LineWidth = Word.WdLineWidth.wdLineWidth050pt
' .Color = Word.WdColor.wdColorAutomatic
' End With
' With .Borders(Word.WdBorderType.wdBorderVertical)
' .LineStyle = Word.WdLineStyle.wdLineStyleSingle
' .LineWidth = Word.WdLineWidth.wdLineWidth050pt
' .Color = Word.WdColor.wdColorAutomatic
' End With
' .Borders(Word.WdBorderType.wdBorderDiagonalDown).LineStyle = Word.WdLineStyle.wdLineStyleNone
' .Borders(Word.WdBorderType.wdBorderDiagonalUp).LineStyle = Word.WdLineStyle.wdLineStyleNone
' .Borders.Shadow = False
'End With
' Save this word document
oDoc.SaveAs("C:UsersCoDeXeRDesktopWord1.doc", True)
oDoc.Close()
oWord.Application.Quit()
'oWord.Visible = True
End Sub
Public Sub exportToExcel(ByVal dgv As DataGridView)
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
End Class
仅仅调用.Quit()
将不会从内存中删除应用程序。在完成编码之后关闭对象是非常重要的。这确保了所有对象都被正确释放,并且内存中没有任何东西保留。
请看下面的例子
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
'~~> Define your Excel Objects
Dim xlApp As New Excel.Application
Dim xlWorkBook As Excel.Workbook
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
'~~> Add a New Workbook
xlWorkBook = xlApp.Workbooks.Add
'~~> Display Excel
xlApp.Visible = True
'~~> Do some stuff Here
'~~> Save the file
xlWorkBook.SaveAs(Filename:="C:TutorialSampleNew.xlsx", FileFormat:=51)
'~~> Close the File
xlWorkBook.Close()
'~~> Quit the Excel Application
xlApp.Quit()
'~~> Clean Up
releaseObject (xlApp)
releaseObject (xlWorkBook)
End Sub
'~~> Release the objects
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
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Me.Close()
End Sub
End Class
同样值得一提的是2 DOT规则。
如果你喜欢从VB自动化Excel。那么你可能也想看看这个链接。
后续
问题在于我上面提到的2 DOT规则。当你使用2 DOT规则(例如:Excel.XlBordersIndex.xlDiagonalDown
),那么你必须使用GC.Collect()
做垃圾收集。所以你需要做的就是添加
Finally
GC.Collect()
Private Sub ReleaseObject(ByVal obj As Object)
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
最终代码
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim xlApp As New excel.Application
Dim xlWorkBook As excel.Workbook
Dim xlWorkSheet As excel.Worksheet
Dim xlRange As excel.Range
'Dim misValue As Object = System.Reflection.Missing.Value
xlWorkBook = xlApp.Workbooks.Add
xlWorkSheet = DirectCast(xlWorkBook.Sheets("sheet1"), excel.Worksheet)
xlApp.Visible = True
Dim headers = (From ch In DataGridView1.Columns _
Let header = DirectCast(DirectCast(ch, DataGridViewColumn).HeaderCell, DataGridViewColumnHeaderCell) _
Select header.Value).ToArray()
Dim headerText() As String = Array.ConvertAll(headers, Function(v) v.ToString)
Dim items() = (From r In DataGridView1.Rows _
Let row = DirectCast(r, DataGridViewRow) _
Where Not row.IsNewRow _
Select (From cell In row.Cells _
Let c = DirectCast(cell, DataGridViewCell) _
Select c.Value).ToArray()).ToArray()
Dim table As String = String.Join(vbTab, headerText) & Environment.NewLine
For Each a In items
Dim t() As String = Array.ConvertAll(a, Function(v) v.ToString)
table &= String.Join(vbTab, t) & Environment.NewLine
Next
table = table.TrimEnd(CChar(Environment.NewLine))
Clipboard.SetText(table)
Dim alphabet() As Char = "abcdefghijklmnopqrstuvwxyz".ToUpper.ToCharArray
xlRange = xlWorkSheet.Range("B2:" & alphabet(headerText.Length) & (items.Length + 2).ToString)
xlRange.Select()
xlWorkSheet.Paste()
xlRange.Borders(excel.XlBordersIndex.xlDiagonalDown).LineStyle = excel.XlLineStyle.xlLineStyleNone
xlRange.Borders(excel.XlBordersIndex.xlDiagonalUp).LineStyle = excel.XlLineStyle.xlLineStyleNone
With xlRange.Borders(excel.XlBordersIndex.xlEdgeLeft)
.LineStyle = excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = excel.XlBorderWeight.xlMedium
End With
With xlRange.Borders(excel.XlBordersIndex.xlEdgeTop)
.LineStyle = excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = excel.XlBorderWeight.xlMedium
End With
With xlRange.Borders(excel.XlBordersIndex.xlEdgeBottom)
.LineStyle = excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = excel.XlBorderWeight.xlMedium
End With
With xlRange.Borders(excel.XlBordersIndex.xlEdgeRight)
.LineStyle = excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = excel.XlBorderWeight.xlMedium
End With
With xlRange.Borders(excel.XlBordersIndex.xlInsideVertical)
.LineStyle = excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = excel.XlBorderWeight.xlThin
End With
With xlRange.Borders(excel.XlBordersIndex.xlInsideHorizontal)
.LineStyle = excel.XlLineStyle.xlContinuous
.ColorIndex = 1 'black
.TintAndShade = 0
.Weight = excel.XlBorderWeight.xlThin
End With
xlWorkBook.SaveAs(Filename:="C:UsersSiddharth RoutDesktopWord1.xls", FileFormat:=56)
xlWorkBook.Close()
xlApp.Quit()
ReleaseObject(xlRange)
ReleaseObject(xlWorkSheet)
ReleaseObject(xlWorkBook)
ReleaseObject(xlApp)
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
以上建议对我都不起作用,直到我关注了@SiddharthRout上面的评论。"今天,使用COM对象的正确方法是什么?"
它指出com对象引用在调试器下保持活动。一种变通方法是从调用com过程的过程中调用GC。
在TRY Catch块中从Finally运行GC。
复制自:post by "Govert" on what is the right way to work with COM objects?
using System;
using System.Runtime.InteropServices;
using Microsoft.Office.Interop.Excel;
namespace TestCsCom
{
Class Program
{
static void Main(string[] args)
{
// NOTE: Don't call Excel objects in here...
// Debugger would keep alive until end, preventing GC cleanup
// Call a separate function that talks to Excel
DoTheWork();
// Now let the GC clean up (repeat, until no more)
do
{
GC.Collect();
GC.WaitForPendingFinalizers();
}
while (Marshal.AreComObjectsAvailableForCleanup());
}
static void DoTheWork()
{
Application app = new Application();
Workbook book = app.Workbooks.Add();
Worksheet worksheet = book.Worksheets["Sheet1"];
app.Visible = true;
for (int i = 1; i <= 10; i++) {
worksheet.Cells.Range["A" + i].Value = "Hello";
}
book.Save();
book.Close();
app.Quit();
// NOTE: No calls the Marshal.ReleaseComObject() are ever needed
}
}
}
我遇到了类似的情况,谷歌把我带到这里。我尝试了上面的答案,但都不起作用。但它足以引导我走上正确的道路。
- 在其他答案中提到的ReleaseObject函数不起作用。Excel一直在后台运行
-
GC.Collect
+GC.WaitForPendingFinalizers()
组合是可行的,但是它们必须在定义excel.com对象的函数之外调用。
例如:
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim xlApp As New Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
xlWorkBook = xlApp.Workbooks.Add
xlWorkSheet = DirectCast(xlWorkBook.Sheets("sheet1"), Excel.Worksheet)
xlWorkBook.Close()
xlApp.Quit()
GC.Collect()
GC.WaitForPendingFinalizers()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Button1Proc()
GC.Collect()
GC.WaitForPendingFinalizers()
End Sub
Private Sub Button1Proc() Handles Button1.Click
Dim xlApp As New Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
xlWorkBook = xlApp.Workbooks.Add
xlWorkSheet = DirectCast(xlWorkBook.Sheets("sheet1"), Excel.Worksheet)
xlWorkBook.Close()
xlApp.Quit()
End Sub
我曾多次使用在脚本中关闭EXCEL文档的能力,同时隐藏使其可见,现在关闭,如果它是唯一打开的工作簿,否则关闭此工作表。这是我的
Sub ExitWorkBook()
Dim wb As Workbook
Dim c As Integer
c = 0
For Each wb In Application.Workbooks
c = c + 1
Next wb
If c = 1 Then
Application.Quit '--Quit this worksheet but keep excel open.
Else
Workbooks("(excel workbook name).xls").Close '-- Close Excel
End If
'
End Sub
For Each w In Application.Workbooks
w.Save
Next w
Application.Quit
我也遇到了同样的问题。但是,这个问题只在调试时持续存在。你所需要做的就是
xlWorkBook.Close
xlApp.Quit
然后让代码运行。您可能需要在Button1_Click
完成后调用垃圾收集器,但我甚至不需要这样做。似乎是步进代码或不让它完全完成会把事情扔掉,使Excel打开。
参见Excel进程在VB.net中未关闭
我用:
解决了这个问题Set xlApp = Nothing
可以查看监控TaskManager
我发现每个引用到Excel对象的实例都必须显式释放:
xlApp = New Excel.Application
xlWorkBooks = xlApp.Workbooks
xlWorkBook = xlWorkBooks.Open(Me.txtFilePath.Text)
xlWorkSheets = xlWorkBook.Worksheets
xlWorkSheet = CType(xlWorkSheets(1), Excel.Worksheet)
xlWorkBook.Close()
xlWorkBooks.Close()
xlApp.Quit()
releaseObject(xlWorkSheet)
xlWorkSheet = Nothing
releaseObject(xlWorkSheets)
xlWorkSheets = Nothing
releaseObject(xlWorkBook)
xlWorkBook = Nothing
releaseObject(xlWorkBooks)
xlWorkBooks = Nothing
releaseObject(xlApp)
xlApp = Nothing
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
我在工作后使用这个函数,在XlApp调用的第一个中,将now()日期设置为FirstDate
Private Sub End_Excel_App_After_Work(ByVal DateStart As Date, ByVal DateEnd As Date)
Dim xlp() As Process = Process.GetProcessesByName("EXCEL")
For Each Process As Process In xlp
If Process.StartTime >= DateStart Then
If Process.StartTime <= DateEnd Then
Process.Kill()
Exit For
End If
End If
Next
xlp = Process.GetProcessesByName("Microsoft EXCEL")
For Each Process As Process In xlp
If Process.StartTime >= DateStart Then
If Process.StartTime <= DateEnd Then
Process.Kill()
Exit For
End If
End If
Next
xlp = Process.GetProcessesByName("EXCEL.EXE")
For Each Process As Process In xlp
If Process.StartTime >= DateStart Then
If Process.StartTime <= DateEnd Then
Process.Kill()
Exit For
End If
End If
Next
End Sub
和后进程调用此函数。像这样:
Dim FromDT As Date = Now
Dim xlApp As New Excel.Application
xlApp = New Excel.Application()
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Microsoft.Office.Interop.Excel.Application()
'End Using
Try
xlWorkBook = xlApp.Workbooks.Open("d:"FIle NAME".xlsX")
xlWorkSheet = xlWorkBook.Worksheets("WORKSHEET")
...CODE BE IN HERE
xlWorkBook.Close()
xlApp.Quit()
xlApp = Nothing
ReleaseObject(xlApp)
ReleaseObject(xlWorkBook)
ReleaseObject(xlWorkSheet)
End_Excel_App_After_Work(FromDT, Now)
Catch ex As Exception
xlApp.Application.Quit()
End_Excel_App_After_Work(FromDT, Now)
End Try
我有一个关于释放对象的代码问题。
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
在上面的子函数中,传递给对象的是ByVal,它传递给您试图释放的对象的副本。有点无意义。你应该传递ByRef,它传递一个引用(对于熟悉c++的人来说,或者是指向内存中的对象的指针),然后上面的例程将释放对象正在使用的内存。
保罗请使用
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()
Try
'Dim MSExcelControl() As Process
Dim iID As Integer
Dim lastOpen As DateTime
Dim obj1(10) As Process
obj1 = Process.GetProcessesByName("EXCEL")
lastOpen = obj1(0).StartTime
For Each p As Process In obj1
If lastOpen < p.StartTime Then
iID = p.Id
Exit For
End If
Next
For Each p As Process In obj1
If p.Id = iID Then
p.Kill()
Exit For
End If
Next
Catch ex As Exception
End Try
End Try
End Sub