在VB.net中多线程打开Excel，然后填写内容保存

Question

我要做个小工具，我有个Excel文件，里面的内容要从数据库中读取出来填写到Excel对应的单元格中，并生成多个Excel文件，因为量大，采用多线程方式同时开启5个线程，但是测试的时候有些机器出几个Excel进程就无响应，有的机器就输出的能多些，但是出道一定程度进程也无响应。有没有哪位大神研究过，看看是什么原因造成的。

Answer 1

从你的描述里没有办法直接定位到问题所在，原因有很多，线程数量过多、资源使用后未释放、或者资源被独占造成访问冲突、甚至计算机资源耗尽造成卡死都有可能。总体来说我想应该是碰到了异常，但你的多线程里没有异常捕获导致抛不出来（或者虽然有异常捕获，但是由于线程安全未能正常抛出）。
如果只是单纯想绕开这个问题，建议你改用NPOI。
如果想深究问题到底出在哪儿，那就在每个线程代码的外层包一层Try Catch，然后在Catch里记录下所有异常。

Answer 2

  代码比较凌乱，整理了一下，麻烦楼上二位给看看 Public Module Mod_MultiThreads
    Public Delegate Sub ProcessSub(ByVal pFile As Object, ByRef pWorker As Object) '这是最终处理函数
    Public Delegate Sub MultiThreadsSub(ByVal pData As Object, ByVal pProcessFunc As ProcessSub) '这个委托是直接线程函数，其所关联方法应根据实际情况而写可参考本类中ServeForMultiThread方法而写
    Public Delegate Sub MultiThreadsSub2(ByVal pData As Object) '这里pData可能传递的是数据集合，可能是单数据，注意判断。可以直接调用字典对象,传入多参数。这样也可以处理多参数问题
    Public Dyn_Object As New Dynamic.ExpandoObject '动态对象，可以动态添加成员和方法
    ''' <summary>
    ''' '开启多线程函数，仅用于开启多个excel线程来处理文件
    ''' </summary>
    ''' <param name="pCollectObj">数据集合,</param>
    ''' <param name="pProcessSub">具体处理数据函数</param>
    ''' <param name="pGroupNum">每组成员数</param>
    ''' <param name="pThreadNum">一次开启线程数，不要过大(小于200),否则容易使程序崩溃</param>
    ''' <res>'此处注意，数据集合中所有数据类型将被转换为object，请在线程函数中进行类型转换</res>
    Public Sub StartMultiThreadsOnlyForExcel(ByVal pCollectObj As Object, ByVal pProcessSub As ProcessSub, Optional ByVal pGroupNum As Integer = 30, Optional ByVal pThreadNum As Integer = 30)        Dim m_lList As New List(Of Object)
        Dim m_lZList As New List(Of List(Of Object))
        Try
            If TypeOf pCollectObj Is OleDb.OleDbDataReader Then '增加此代码，解决不能传入过大数据集合问题。
                Do While pCollectObj.read
                    m_lList.Add(pCollectObj.Item(0))
                    If m_lList.Count = pGroupNum Then
                        m_lZList.Add(m_lList)
                        m_lList = New List(Of Object)
                    End If                    If m_lZList.Count = pThreadNum Then                        '开启多线程  TODO
                        Parallel.ForEach(m_lZList, Sub(ITem) ServeForMultiThread(ITem, pProcessSub))
                        '处理list,减轻内存压力
                        For Each pList As List(Of Object) In m_lZList
                            pList.Clear()
                            pList = Nothing
                        Next
                        m_lZList.Clear()
                    End If
                Loop
            Else
                For Each pMember As Object In pCollectObj
                    m_lList.Add(pMember)
                    If m_lList.Count = pGroupNum Then
                        m_lZList.Add(m_lList)
                        m_lList = New List(Of Object)
                    End If                    If m_lZList.Count = pThreadNum Then                        '开启多线程  TODO
                        Parallel.ForEach(m_lZList, Sub(ITem) ServeForMultiThread(ITem, pProcessSub))
                        '处理list,减轻内存压力
                        For Each pList As List(Of Object) In m_lZList
                            pList.Clear()
                            pList = Nothing
                        Next
                        m_lZList.Clear()
                    End If                Next
            End If
            If m_lZList.Count > 0 Then                'TODO
                Parallel.ForEach(m_lZList, Sub(ITem) ServeForMultiThread(ITem, pProcessSub))
                For Each pList As List(Of Object) In m_lZList
                    pList.Clear()
                    pList = Nothing
                Next
            End If            If m_lList.Count > 0 Then                'TODO
                Parallel.ForEach(m_lList, Sub(ITem) ServeForMultiThread(ITem, pProcessSub))
                m_lList.Clear()
                m_lList = Nothing
            End If
        Catch ex As Exception
            GYPublicInfo.PublicInfo.ErrCl(ex.ToString())
        Finally
            If Not m_lZList Is Nothing Then
                m_lZList.Clear()
                m_lZList = Nothing
            End If            If Not m_lList Is Nothing Then
                m_lList.Clear()
                m_lList = Nothing
            End If
        End Try    End Sub
  
End Module
    Private Function OutputDCB_MultiThread_HuNanSheng(ByVal ListBM As List(Of String)) As Boolean
        Dim m_lDCB_Print As ProcessSub = AddressOf Single_OutputDCB
        Dim m_lGroupNum As Integer = 30
        Dim m_lThreadsNum As Integer = 30        StartMultiThreadsOnlyForExcel(ListBM, m_lDCB_Print, m_lGroupNum, m_lThreadsNum)
        Return True
    End Function
Private Function Single_OutputDCB(ByVal SingleCBFBM As String, ByRef pPutOutExcel As GY.gnp.CPutOutExcel) As Boolean
        Dim ModulePath As String
        Dim _OutputFullpath As String        Try
            If _OutputFolderType.ToUpper = "CBF" Then
                Dim locked1 As Boolean = False
                Try
                    GYPublicInfo.PublicInfo.locker.Enter(locked1)                    If System.IO.Directory.Exists(_OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\" & SingleCBFBM & "\") = False Then
                        System.IO.Directory.CreateDirectory(_OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\" & SingleCBFBM & "\")
                    End If
                Catch ex As Exception
                Finally
                    If locked1 Then GYPublicInfo.PublicInfo.locker.Exit()
                End Try
                _OutputFullpath = _OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\" & SingleCBFBM & "\" & SingleCBFBM & "调查表.xls"            ElseIf _OutputFolderType.ToUpper = "ZU" Then
                Dim locked1 As Boolean = False
                Try
                    GYPublicInfo.PublicInfo.locker.Enter(locked1)                    If System.IO.Directory.Exists(_OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\") = False Then
                        System.IO.Directory.CreateDirectory(_OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\")
                    End If
                Catch ex As Exception
                Finally
                    If locked1 Then GYPublicInfo.PublicInfo.locker.Exit()
                End Try
                _OutputFullpath = _OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\" & SingleCBFBM & "调查表.xls"
            End If
            ModulePath = System.Windows.Forms.Application.StartupPath & "\File\ExcelTemplate\调查表\湖南省\调查表.xls"
            GYPublicInfo.PublicInfo.ErrCl(ModulePath)
            FileCopy(ModulePath, _OutputFullpath)
            pPutOutExcel.NewExcel.ObjExcelBook = pPutOutExcel.NewExcel.ObjExcel.Workbooks.Open(_OutputFullpath)
            pPutOutExcel.NewExcel.SheetActivateIndex = 1            Dim pDTcbf As New DataTable
            Dim pDTgyr As New DataTable
            Dim pDT As New DataTable
            Dim pData As New GDP.CData(PublicInfo.PublicInfo.Connection)            GYPublicInfo.PublicInfo.Sem.WaitOne()
            pDTcbf = pData.DataTableResult("select * from cbkf where bm='" & SingleCBFBM & "'")
            GYPublicInfo.PublicInfo.Sem.Release()            If pDTcbf.Rows.Count > 0 Then
                pPutOutExcel.NewExcel.RangeValue(2, 3) = Microsoft.VisualBasic.Left(SingleCBFBM, 14)
                pPutOutExcel.NewExcel.RangeValue(2, 9) = Microsoft.VisualBasic.Right(SingleCBFBM, 4)                Dim sZJLX_NAME As String
                GYPublicInfo.PublicInfo.Sem.WaitOne()
                sZJLX_NAME = pData.ExecuteScalarCstr("select mc from D_ZJLX where dm='" & pDTcbf.Rows(0)("ZJLX") & "" & "'")
                GYPublicInfo.PublicInfo.Sem.Release()
       
                pPutOutExcel.NewExcel.RangeValue(5, 3) = "R身份证"
                pPutOutExcel.NewExcel.ExcelCharInvaild("C5", "F5", "R身份证")
                pPutOutExcel.NewExcel.RangeValue(5, 8) = pDTcbf.Rows(0)("ZJHM") & ""
                GYPublicInfo.PublicInfo.Sem.WaitOne()
                pDT = pData.DataTableResult("select * from CBDJB where CBFBM='" & SingleCBFBM & "'")
                GYPublicInfo.PublicInfo.Sem.Release()            End If            Return True
        Catch ex As Exception
            Dim lock2 As Boolean = False
            Try
                GYPublicInfo.PublicInfo.locker.Enter(lock2)
                GYPublicInfo.PublicInfo.ErrCl(ex.ToString())
                _StrB_OutputLog.AppendLine(ex.ToString())
            Catch exp As Exception
            Finally
                If lock2 Then PublicInfo.PublicInfo.locker.Exit()
            End Try            Return False
        Finally
            Try
here:
                pPutOutExcel.NewExcel.ObjExcelBook.Save()
            Catch ex As Exception
                GoTo here
            End Try            pPutOutExcel.NewExcel.ObjExcelBook.Close()
            System.Runtime.InteropServices.Marshal.ReleaseComObject(pPutOutExcel.NewExcel.ObjExcelBook)
            pPutOutExcel.NewExcel.ObjExcelBook = Nothing
        End Try    End Function

Answer 3

把GOTO去掉。
GoTo here 改成 MessageBox.Show(ex.ToString())
每个Catch代码块里，要把Exception给显示出来，写到文本文件也好，弹MessageBox也好，否则这个异常捕获没有意义。

Answer 4

goto here不报错吗？以前好像也这么用过但报错