我要做個小工具，我有個Excel檔案，里面的內容要從資料庫中讀取出來填寫到Excel對應的單元格中，并生成多個Excel檔案，因為量大，采用多執行緒方式同時開啟5個執行緒，但是測驗的時候有些機器出幾個Excel行程就無回應，有的機器就輸出的能多些，但是出道一定程度行程也無回應。有沒有哪位大神研究過，看看是什么原因造成的。
uj5u.com熱心網友回復：
從你的描述里沒有辦法直接定位到問題所在，原因有很多，執行緒數量過多、資源使用后未釋放、或者資源被獨占造成訪問沖突、甚至計算機資源耗盡造成卡死都有可能。總體來說我想應該是碰到了例外，但你的多執行緒里沒有例外捕獲導致拋不出來（或者雖然有例外捕獲，但是由于執行緒安全未能正常拋出）。如果只是單純想繞開這個問題，建議你改用NPOI。
如果想深究問題到底出在哪兒，那就在每個執行緒代碼的外層包一層Try Catch，然后在Catch里記錄下所有例外。
uj5u.com熱心網友回復：
問題描述得太含糊。
有不少的問題，是別人“猜”不出來的，得“具體問題具體分析”，如果可以的話，最好能把你的代碼放出來。
uj5u.com熱心網友回復：
代碼比較凌亂，整理了一下，麻煩樓上二位給看看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
uj5u.com熱心網友回復：
把GOTO去掉。GoTo here 改成 MessageBox.Show(ex.ToString())
每個Catch代碼塊里，要把Exception給顯示出來，寫到文本檔案也好，彈MessageBox也好，否則這個例外捕獲沒有意義。
uj5u.com熱心網友回復：
goto here不報錯嗎？以前好像也這么用過但報錯轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/50027.html
標籤：VB基礎類