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

[ZJY780505]

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

[X-i-n]

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

[舉杯邀明月]

问题描述得太含糊。 有不少的问题，是别人“猜”不出来的，得“具体问题具体分析”，如果可以的话，最好能把你的代码放出来。

[ZJY780505]

代码比较凌乱，整理了一下，麻烦楼上二位给看看 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> ''' <remarks>'此处注意，数据集合中所有数据类型将被转换为object，请在线程函数中进行类型转换</remarks> 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

[X-i-n]

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

[lylkr]

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