专家坐堂-如何在不关闭程序的情况下释放EXCELFoxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  如何在不关闭程序的情况下释放EXCEL  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=95835)

--  作者：wh420
--  发布时间：2017/2/6 17:54:00
--  如何在不关闭程序的情况下释放EXCEL

下列代码第3行-第7行代码在狐表中好像不支持，转换成狐表的代码应该如何写？

// 9.释放资源
    System.Runtime.InteropServices.Marshal.ReleaseComObject(rng);
    System.Runtime.InteropServices.Marshal.ReleaseComObject(ws);
    System.Runtime.InteropServices.Marshal.ReleaseComObject(wb);
    System.Runtime.InteropServices.Marshal.ReleaseComObject(wbs);
    System.Runtime.InteropServices.Marshal.ReleaseComObject(excelApp);

    // 10.调用GC的垃圾收集方法
    GC.Collect();
    GC.WaitForPendingFinalizers();

--  作者：有点色
--  发布时间：2017/2/6 18:17:00
--
你打开excel后，把excel关闭，自然就释放资源了啊。

--  作者：wh420
--  发布时间：2017/2/6 18:56:00
--
程序执行app.quit()后仍然有进程在系统里

--  作者：wh420
--  发布时间：2017/2/6 19:01:00
--
而且设置了app.DisplayAlerts=False,但似乎总是有一个EXCEL关不掉

--  作者：有点色
--  发布时间：2017/2/6 20:07:00
--

只要app.quit执行了，不可能还存在。

实例说明。

--  作者：wh420
--  发布时间：2017/2/6 23:51:00
--
app.quit()的确把EXCEL进程关掉了，只是比较慢。但我的程序反复执行的时候，程序本身占用的内存越来越大导致最后内存不够，得重新关闭程序后才能释放内存，请问如何在程序每执行完一个EXCEL就释放一次内存？
程序代码如下：

For Each file In FileSys.GetFiles(path)
Dim excelcol As Integer
Dim excelrows As Integer
If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
DataTables("表A").StopRedraw
Dim App As New MSExcel.Application
app.DisplayAlerts=False \'是否显示EXCEL警示
try
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(file)
For k As Integer = 1 To wb.workSheets.Count \'//多个sheet的处理
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(k)
Dim Rg As MSExcel.Range = Ws.UsedRange

Dim RowsMax As Integer =0
Dim ColsMax As Integer = 0
\'获取有效行
For i As Integer =1 To rg.Columns.count
Dim r = ws.cells(excelrows,i).End(MsExcel.XlDirection.xlUp).Row
If r > RowsMax Then
RowsMax = r
End If
Next
\'获取有效列
For i As Integer = 1 To rowsMax
Dim r = ws.cells(i,excelcol).End(MsExcel.XLDirection.xlToLeft).Column
If r > ColsMax Then
ColsMax = r
End If
Next
rg = Ws.Range(Ws.Cells(1,1), Ws.Cells(RowsMax,ColsMax))
Dim ary = rg.value

For i As Integer = 1 To RowsMax
If CBox2.Checked OrElse rg.Rows(i).height <> 0 Then
For j As Integer = 1 To Colsmax
If CBox2.Checked OrElse rg.Columns(j).width <> 0 Then

If ary(i,j) <> Nothing Then
If CBox1.Checked = False OrElse CBox1.Checked = True AndAlso System.Text.RegularExpressions.Regex.Match(ary(i,j),"[\\u4e00-\\u9fa5]+").Tostring()>""
Dim dr As DataRow = DataTables("表A").AddNew
dr("原文") = ary(i, j)
lbl5.text ="提取内容:" & ary(i,j)
Application.DoEvents
End If
End If
End If
Next
End If
Next
Next

Wb.Close()

Dim txt1 As WinForm.TextBox = Forms("提取工具").Controls("TextBox3")
txt1.text = file & vbcrlf & txt1.text & vbcrlf
Application.DoEvents()
FileCount=FileCount+1
lbl.Text="已提取" & FileCount & "个文件,未提取 " & BadFileCount & "个文件"

Catch ex As Exception
Dim txt2 As WinForm.TextBox = Forms("提取工具").Controls("TextBox4")
txt2.text = file & vbcrlf & txt2.text & vbcrlf
BadFileCount =BadFileCount +1
msgbox(ex.message)
End try
DataTables("表A").ResumeRedraw
app.quit()
GC.ColLECT
End If
Next
For Each p As String In FileSys.GetDirectories(path)
Functions.Execute("MSEXCEL提取", p)
Next

--  作者：wh420
--  发布时间：2017/2/6 23:52:00
--
用GC.Collect()好像没什么效果

--  作者：有点蓝
--  发布时间：2017/2/7 8:54:00
--
Excel的释放是有一定的延迟，慢的可能要几十秒，这个控制不了。除非强制杀掉进程。GC.Collect()也不要频繁执行，否则会有反作用。

试试

DataTables("表A").StopRedraw
Dim App As New MSExcel.Application
app.DisplayAlerts=False \'是否显示EXCEL警示
For Each file In FileSys.GetFiles(path)
Dim excelcol As Integer
Dim excelrows As Integer
If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
Dim Wb As MSExcel.WorkBook
Dim Ws As MSExcel.WorkSheet
try
Wb = App.WorkBooks.Open(file)
For k As Integer = 1 To wb.workSheets.Count \'//多个sheet的处理
Ws = Wb.WorkSheets(k)
Dim Rg As MSExcel.Range = Ws.UsedRange

Dim RowsMax As Integer =0
Dim ColsMax As Integer = 0
\'获取有效行
For i As Integer =1 To rg.Columns.count
Dim r = ws.cells(excelrows,i).End(MsExcel.XlDirection.xlUp).Row
If r > RowsMax Then
RowsMax = r
End If
Next
\'获取有效列
For i As Integer = 1 To rowsMax
Dim r = ws.cells(i,excelcol).End(MsExcel.XLDirection.xlToLeft).Column
If r > ColsMax Then
ColsMax = r
End If
Next
rg = Ws.Range(Ws.Cells(1,1), Ws.Cells(RowsMax,ColsMax))
Dim ary = rg.value

For i As Integer = 1 To RowsMax
If CBox2.Checked OrElse rg.Rows(i).height <> 0 Then
For j As Integer = 1 To Colsmax
If CBox2.Checked OrElse rg.Columns(j).width <> 0 Then

If ary(i,j) <> Nothing Then
If CBox1.Checked = False OrElse CBox1.Checked = True AndAlso System.Text.RegularExpressions.Regex.Match(ary(i,j),"[\\u4e00-\\u9fa5]+").Tostring()>""
Dim dr As DataRow = DataTables("表A").AddNew
dr("原文") = ary(i, j)
lbl5.text ="提取内容:" & ary(i,j)
Application.DoEvents
End If
End If
End If
Next
End If
Next
Next
Dim txt1 As WinForm.TextBox = Forms("提取工具").Controls("TextBox3")
txt1.text = file & vbcrlf & txt1.text & vbcrlf
Application.DoEvents()
FileCount=FileCount+1
lbl.Text="已提取" & FileCount & "个文件,未提取 " & BadFileCount & "个文件"

Catch ex As Exception
Dim txt2 As WinForm.TextBox = Forms("提取工具").Controls("TextBox4")
txt2.text = file & vbcrlf & txt2.text & vbcrlf
BadFileCount =BadFileCount +1
msgbox(ex.message)
finally
If ws IsNot Nothing Then ws = Nothing
If Wb IsNot Nothing Then Wb.Close(Type.Missing, Type.Missing, Type.Missing)
If Wb IsNot Nothing Then Wb = Nothing
End try
End If
Next

DataTables("表A").ResumeRedraw
app.quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(app)
If app IsNot Nothing Then app = Nothing
GC.WaitForPendingFinalizers()
GC.Collect()
GC.WaitForPendingFinalizers()
GC.Collect()
For Each p As String In FileSys.GetDirectories(path)
Functions.Execute("MSEXCEL提取", p)
Next

--  作者：有点色
--  发布时间：2017/2/7 9:22:00
--
回复6楼，尽量不要在循环里面new对象，特别是循环次数较多的情况。

--  作者：wh420
--  发布时间：2017/2/7 16:31:00
--
老师我按您写的代码做了一个例子，例子报错（异常来自HRESULT)，您给看一下。

下载信息  [文件大小：   下载次数： ]
点击浏览该文件:管理项目5.rar