Foxtable(狐表)用户栏目专家坐堂 → 如何在不关闭程序的情况下释放EXCEL


  共有1931人关注过本帖树形打印复制链接

主题:如何在不关闭程序的情况下释放EXCEL

帅哥哟,离线,有人找我吗?
wh420
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10562 威望:0 精华:0 注册:2014/2/19 16:32:00
如何在不关闭程序的情况下释放EXCEL  发帖心情 Post By:2017/2/6 17:54:00 [只看该作者]

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

  2.  // 9.释放资源  
  3.     System.Runtime.InteropServices.Marshal.ReleaseComObject(rng);  
  4.     System.Runtime.InteropServices.Marshal.ReleaseComObject(ws);  
  5.     System.Runtime.InteropServices.Marshal.ReleaseComObject(wb);  
  6.     System.Runtime.InteropServices.Marshal.ReleaseComObject(wbs);  
  7.     System.Runtime.InteropServices.Marshal.ReleaseComObject(excelApp);  
  8.   
  9.     // 10.调用GC的垃圾收集方法  
  10.     GC.Collect();  
  11.     GC.WaitForPendingFinalizers(); 

 回到顶部
帅哥哟,离线,有人找我吗?
有点色
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:13837 积分:69650 威望:0 精华:0 注册:2016/11/1 14:42:00
  发帖心情 Post By:2017/2/6 18:17:00 [只看该作者]

 你打开excel后,把excel关闭,自然就释放资源了啊。

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10562 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2017/2/6 18:56:00 [只看该作者]

程序执行app.quit()后仍然有进程在系统里

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10562 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2017/2/6 19:01:00 [只看该作者]

而且设置了app.DisplayAlerts=False,但似乎总是有一个EXCEL关不掉

 回到顶部
帅哥哟,离线,有人找我吗?
有点色
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:13837 积分:69650 威望:0 精华:0 注册:2016/11/1 14:42:00
  发帖心情 Post By:2017/2/6 20:07:00 [只看该作者]

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

 

 实例说明。


 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10562 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By: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
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10562 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2017/2/6 23:52:00 [只看该作者]

用GC.Collect()好像没什么效果

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:106320 积分:540735 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By: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

 回到顶部
帅哥哟,离线,有人找我吗?
有点色
  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:13837 积分:69650 威望:0 精华:0 注册:2016/11/1 14:42:00
  发帖心情 Post By:2017/2/7 9:22:00 [只看该作者]

 回复6楼,尽量不要在循环里面new对象,特别是循环次数较多的情况。

 回到顶部
帅哥哟,离线,有人找我吗?
wh420
  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1107 积分:10562 威望:0 精华:0 注册:2014/2/19 16:32:00
  发帖心情 Post By:2017/2/7 16:31:00 [只看该作者]

老师我按您写的代码做了一个例子,例子报错(异常来自HRESULT),您给看一下。

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目5.rar




 回到顶部
总数 13 1 2 下一页