پیغم خطای Transition into COM context

[boveiryghasem]

سلام

یه برنامه دارم که توی یک ListBox تعداد 300 آدرس فایل Excel دارم و میخام یکی یکی آدرسا رو بخونم و باز کنم فایل ها رو، بعدش که تغییرات لازم رو دادم اون فایل رو Save کنم و برم سراغ فایل بعدی تا آخر لیستی که از ListBox دارم، مشکل اینجاست که آخراش Error زیر رو میده کسی میدونه باید چکار کنم.

Transition into COM context 0x13c74a8 for this RuntimeCallableWrapper failed with the following error: System call failed. (Exception from HRESULT: 0x80010100 (RPC_E_SYS_CALL_FAILED)). This is typically because the COM context 0x13c74a8 where this RuntimeCallableWrapper was created has been disconnected or it is busy doing something else. Releasing the interfaces from the current COM context (COM context 0x13c73f0). This may cause corruption or data loss. To avoid this problem, please ensure that all COM contexts/apartments/threads stay alive and are available for context transition, until the application is completely done with the RuntimeCallableWrappers that represents COM components that live inside them.

[the king]

سلام

یه برنامه دارم که توی یک ListBox تعداد 300 آدرس فایل Excel دارم و میخام یکی یکی آدرسا رو بخونم و باز کنم فایل ها رو، بعدش که تغییرات لازم رو دادم اون فایل رو Save کنم و برم سراغ فایل بعدی تا آخر لیستی که از ListBox دارم، مشکل اینجاست که آخراش Error زیر رو میده کسی میدونه باید چکار کنم.

Transition into COM context 0x13c74a8 for this RuntimeCallableWrapper failed with the following error: System call failed. (Exception from HRESULT: 0x80010100 (RPC_E_SYS_CALL_FAILED)). This is typically because the COM context 0x13c74a8 where this RuntimeCallableWrapper was created has been disconnected or it is busy doing something else. Releasing the interfaces from the current COM context (COM context 0x13c73f0). This may cause corruption or data loss. To avoid this problem, please ensure that all COM contexts/apartments/threads stay alive and are available for context transition, until the application is completely done with the RuntimeCallableWrappers that represents COM components that live inside them.

اشیاء مدیریت شده داخل NET. که داخل متغیر هاتون دارید وقتی دیگه بهشون دسترسی نداشته باشید، توسط GC داخل NET. بصورت خودکار آزاد میشن، ولی اشیاء COM (ActiveX) که شما در برنامه تون استفاده می کنید مثل Workbook و Worksheet و سایر اشیاء ای که از اون Microsoft.Office.Interop.Excel بیرون می کشید رو باید قبل از رها کردن و سپردن دست GC به روش مناسب اشیاء COM آزاد کنید، وگرنه GC نمیتونه اون آزاد سازی بخش COM رو انجام بده، چون بهش مربوط نیست.

ابتدای کدتون System.Runtime.InteropServices رو Imports کنید و آخر کدتون هر چی شیء از Microsoft.Office.Interop.Excel مثل Workbook و Worksheet و Application دارید اگه اسم متغیرش varname باشه :

اول با Marshal.ReleaseComObject(varname) آزاد کنید.
دوم با varname = Nothing خالی کنید.

قبل از اینکه اینجور متغیر ها رو رها کنید یا مقدار دیگری داخل متغیرش قرار بدید باید حتما مقدار قبلی با اون دو تا مرحله آزاد بشه. دقت کنید که این وسط موردی رو جا نندازید.

[boveiryghasem]

ممنون از توضیحاتتون.

کدم رو میزارم اگه چکش کنید ممنون میشم سادس چیز خاصی نداره :

Private Sub btn_Report_Click(sender As Object, e As EventArgs) Handles btn_MciReport.Click
Try
Dim FileCount As Integer = 1
Dim AllVillageName As New List(Of String)
Dim fileName As String = ""
Dim objExcel1 As New Microsoft.Office.Interop.Excel.Application
Dim objWorkBook1 As Workbook
Dim objWorkSheet1, objWorkSheet2 As Worksheet
For i = 0 To lst_FilesEdit.Items.Count - 1


fileName = ""
objWorkBook1 = objExcel1.Workbooks.Open(lst_FilesEdit.Items.Item( i))
objWorkBook1 = objExcel1.Workbooks(1)
objWorkSheet2 = objWorkBook1.Worksheets("Measurments")


Select Case True
Case rdb_Co_1.Checked
objWorkSheet1 = objWorkBook1.Worksheets("Co_1")
objWorkSheet2.Name = "Measurements_Co_1"
Case rdb_Co_1.Checked
objWorkSheet1 = objWorkBook1.Worksheets("Co_2")
objWorkSheet2.Name = "Measurements_Co_2"
End Select


objExcel1.Visible = True
objExcel1.DisplayAlerts = False


'Delete Merg Cells in Row 1
objWorkSheet1.Rows(1).Delete()


'Insert Column for Perf DB
objWorkSheet1.Columns(1).Insert()
objWorkSheet1.Columns(1).Insert()
objWorkSheet1.Columns(1).Insert()
objWorkSheet1.Columns(1).Insert()
objWorkSheet1.Columns(1).Insert()


'Add Name for new Columns
objWorkSheet1.Cells(1, 1).Value = "persian_year"
objWorkSheet1.Cells(1, 2).value = "quarter"
objWorkSheet1.Cells(1, 3).value = "received_date"
objWorkSheet1.Cells(1, 4).value = "persian_village"
objWorkSheet1.Cells(1, 5).value = "english_village"


'Fill Some new column
objWorkSheet1.Cells(2, 1).Value = cmBox_PersianYear.SelectedItem
objWorkSheet1.Cells(2, 2).value = cmBox_Quarters.SelectedItem
objWorkSheet1.Cells(2, 3).value = txt_Received_Date.Text


'Copy Paste as value for afew changes
objWorkSheet1.Range("A1", "AG2").Select()
objWorkSheet1.Range("A1", "AG2").Copy()
objWorkSheet1.Range("A1").PasteSpecial(XlPasteType.xlPasteValuesAndNumberF ormats, XlPasteSpecialOperation.xlPasteSpecialOperationNon e)




'remove third row that using formulas
objWorkSheet1.Rows(3).Delete()


'Replace = char for DB
objWorkSheet1.Range("A1", "AG1").Select()
objWorkSheet1.Range("A1", "AG1").Replace(What:="=", Replacement:="e", MatchCase:=False, SearchFormat:=False)




objWorkSheet1.Cells(1, 6) = "Province"
objWorkSheet1.Cells(1, 7).Value = "Village Name"
objWorkSheet1.Cells(1, 8).Value = "distance (KM)"
Select Case True
Case rdb_Co_1.Checked
objWorkSheet1.Cells(1, 9).Value = "cover for Co_1 (KM)"
objWorkSheet1.Cells(1, 10).Value = "Co_1 cover (%)"
Case rdb_Co_2.Checked
objWorkSheet1.Cells(1, 9).Value = "cover for Co_2 (KM)"
objWorkSheet1.Cells(1, 10).Value = "Co_2 cover (%)"
End Select


'Clean the Village Name
Dim VillageName As String = ""
VillageName = Strings.Right(Regex.Replace(objWorkSheet1.Cells(2, 7).Value.ToString, ", ", ""), Strings.Len(Regex.Replace(objWorkSheet1.Cells(2, 7).Value.ToString, ", ", "")) - 1)
objWorkSheet1.Cells(2, 7).Value = VillageName
AllVillageName.Add(VillageName)


'*/*/*/*/*/**/*/*/*/*/*/*/*/* The Second Sheet "Measurments"
objWorkSheet2.Activate()
objWorkSheet2.Cells.Select()
objWorkSheet2.Cells.Copy()
objWorkSheet2.Range("A1").PasteSpecial(XlPasteType.xlPasteValuesAndNumberF ormats, XlPasteSpecialOperation.xlPasteSpecialOperationNon e)


'Remove the distanced column
For t = 1 To objWorkSheet2.UsedRange.Columns.Count
If objWorkSheet2.Cells(3, t).NumberFormat.ToString = "@" Then
For j = 1 To t - 1
objWorkSheet2.Columns(1).delete()
Next
End If
Next


objWorkSheet2.Cells(2, 1).value = "Date_and_time"


For k = 1 To 5
If objWorkSheet2.Cells(2, 2).value <> "LAT" Then
objWorkSheet2.Columns(2).delete()
Else
Exit For
End If
Next


'Insert Column for Perf DB
objWorkSheet2.Columns(1).Insert()
objWorkSheet2.Columns(1).Insert()
objWorkSheet2.Columns(1).Insert()
objWorkSheet2.Columns(1).Insert()
objWorkSheet2.Columns(1).Insert()


'Add Name for new Columns
objWorkSheet2.Cells(2, 1).Value = "persian_year"
objWorkSheet2.Cells(2, 2).value = "quarter"
objWorkSheet2.Cells(2, 3).value = "received_date"
objWorkSheet2.Cells(2, 4).value = "persian_village"
objWorkSheet2.Cells(2, 5).value = "english_village"


objWorkSheet2.Rows(1).delete()
Dim xx As Integer = objWorkSheet2.UsedRange.Rows.Count
objWorkSheet2.Range("A2:A" & xx).Value = cmBox_PersianYear.SelectedItem
objWorkSheet2.Range("B2:B" & xx).Value = cmBox_Quarters.SelectedItem
objWorkSheet2.Range("C2:C" & xx).Value = txt_Received_Date.Text
objWorkSheet2.Range("D2:D" & xx).Value = VillageName












'Ready to next excel file
objWorkBook1.Close(SaveChanges:=True)


releaseObject(objWorkBook1)
releaseObject(objWorkSheet1)
releaseObject(objWorkSheet2)


GC.Collect()
GC.WaitForPendingFinalizers()


ProgressBar1.Value = Math.Round((FileCount / (lst_FilesEdit.Items.Count - 1) * 100), 1)
Label3.Text = "Please Wait... (" & Math.Round((FileCount / (lst_FilesEdit.Items.Count - 1) * 100), 1) & "%)"
Label3.Refresh()
FileCount = FileCount + 1
'End If
Next


'Save Village Name for Duplicate Name
Dim file As System.IO.StreamWriter
file = My.Computer.FileSystem.OpenTextFileWriter(txt_Path Browse.Text & "\VillageName-" & txt_Received_Date.Text & ".txt", True)
For ii = 0 To AllVillageName.Count - 1
file.WriteLine(AllVillageName(ii))
Next
file.Close()


objWorkSheet1 = Nothing
objWorkSheet2 = Nothing
objWorkBook1 = Nothing
objExcel1.Quit()
objExcel1 = Nothing
GC.Collect()
GC.WaitForPendingFinalizers()


Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub

Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComO bject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub

[the king]

خوب اول تا یادم نرفته بگم که در Select Case True اولی Case دوم رو از Case rdb_Co_1.Checked به Case rdb_Co_2.Checked تغییر بدید.

متاسفانه اون releaseObject ای که دارید نمیتونه معادل اون دو تا مرحله دلخواه ما باشه چون پارامتر obj اش رو Nothing هم بکنه صرفا داخل releaseObject ئه Nothing شده و روی پارامتر ارسالی تاثیری نداره.
یعنی فرضا بعد اون releaseObject(objWorkBook1) که اجرا می کنید objWorkBook1 ئه Nothing نمیشه. برای همین از releaseObject استفاده نمی کنیم.

از طرف دیگه ما کاری به GC نداریم، نه درخواست Collect کنید و نه WaitForPendingFinalizers. اون GC رو رها کنید کار خودشو بکنه.

فرمول درصد progressbar رو هم بهتره تغییر بدید، درصد رو درست محاسبه نمی کنه. این کدی که می نویسم با توجه به این مساله مناسبه که شما FileCount رو با 1 شروع کردید، نه صفر :


ProgressBar1.Value = IIf(lst_FilesEdit.Items.Count = 0, 0, Math.Round(100.0 * FileCount / lst_FilesEdit.Items.Count))
Label3.Text = "Please Wait... (" & ProgressBar1.Value.ToString() & "%)"
FileCount = FileCount + 1
My.Application.DoEvents()

اگر از صفر شروع می کردیم باید FileCount رو قبل از محاسبه درصد افزایش می دادیم.

My.Application.DoEvents به هر تغییری که روی فرم دادید، فرضا متن Label ها، رنگ کنترل ها و ... فرصت میده که تغییراتشون رو نشون بدن. label3.Refresh همچین مهلتی رو ایجاد نمی کنه. برای همین label3.Refresh رو نمی نویسم.

یکی از اون اشیاء COM شما objExcel1 ئه، آزاد کردنش رو از قلم انداختید که مهم ئه :




Private Sub btn_Report_Click(sender As Object, e As EventArgs) Handles btn_MciReport.Click
Try
Dim FileCount As Integer = 1
Dim AllVillageName As New List(Of String)
Dim fileName As String = ""
Dim objExcel1 As New Microsoft.Office.Interop.Excel.Application
Dim objWorkBook1 As Workbook
Dim objWorkSheet1, objWorkSheet2 As Worksheet
For i = 0 To lst_FilesEdit.Items.Count - 1

fileName = ""
objWorkBook1 = objExcel1.Workbooks.Open(lst_FilesEdit.Items.Item( i))
objWorkBook1 = objExcel1.Workbooks(1)
objWorkSheet2 = objWorkBook1.Worksheets("Measurments")

Select Case True
Case rdb_Co_1.Checked
objWorkSheet1 = objWorkBook1.Worksheets("Co_1")
objWorkSheet2.Name = "Measurements_Co_1"
Case rdb_Co_2.Checked
objWorkSheet1 = objWorkBook1.Worksheets("Co_2")
objWorkSheet2.Name = "Measurements_Co_2"
End Select

objExcel1.Visible = True
objExcel1.DisplayAlerts = False

GoTo HERE
'Delete Merg Cells in Row 1
objWorkSheet1.Rows(1).Delete()


'Insert Column for Perf DB
objWorkSheet1.Columns(1).Insert()
objWorkSheet1.Columns(1).Insert()
objWorkSheet1.Columns(1).Insert()
objWorkSheet1.Columns(1).Insert()
objWorkSheet1.Columns(1).Insert()


'Add Name for new Columns
objWorkSheet1.Cells(1, 1).Value = "persian_year"
objWorkSheet1.Cells(1, 2).value = "quarter"
objWorkSheet1.Cells(1, 3).value = "received_date"
objWorkSheet1.Cells(1, 4).value = "persian_village"
objWorkSheet1.Cells(1, 5).value = "english_village"

'Fill Some new column
objWorkSheet1.Cells(2, 1).Value = cmBox_PersianYear.SelectedItem
objWorkSheet1.Cells(2, 2).value = cmBox_Quarters.SelectedItem
objWorkSheet1.Cells(2, 3).value = txt_Received_Date.Text

'Copy Paste as value for afew changes
objWorkSheet1.Range("A1", "AG2").Select()
objWorkSheet1.Range("A1", "AG2").Copy()
objWorkSheet1.Range("A1").PasteSpecial(XlPasteType.xlPasteValuesAndNumberF ormats, XlPasteSpecialOperation.xlPasteSpecialOperationNon e)

'remove third row that using formulas
objWorkSheet1.Rows(3).Delete()

'Replace = char for DB
objWorkSheet1.Range("A1", "AG1").Select()
objWorkSheet1.Range("A1", "AG1").Replace(What:="=", Replacement:="e", MatchCase:=False, SearchFormat:=False)

objWorkSheet1.Cells(1, 6) = "Province"
objWorkSheet1.Cells(1, 7).Value = "Village Name"
objWorkSheet1.Cells(1, 8).Value = "distance (KM)"
Select Case True
Case rdb_Co_1.Checked
objWorkSheet1.Cells(1, 9).Value = "cover for Co_1 (KM)"
objWorkSheet1.Cells(1, 10).Value = "Co_1 cover (%)"
Case rdb_Co_2.Checked
objWorkSheet1.Cells(1, 9).Value = "cover for Co_2 (KM)"
objWorkSheet1.Cells(1, 10).Value = "Co_2 cover (%)"
End Select

'Clean the Village Name
Dim VillageName As String = ""
VillageName = Strings.Right(Regex.Replace(objWorkSheet1.Cells(2, 7).Value.ToString, ", ", ""), Strings.Len(Regex.Replace(objWorkSheet1.Cells(2, 7).Value.ToString, ", ", "")) - 1)
objWorkSheet1.Cells(2, 7).Value = VillageName
AllVillageName.Add(VillageName)


'*/*/*/*/*/**/*/*/*/*/*/*/*/* The Second Sheet "Measurments"
objWorkSheet2.Activate()
objWorkSheet2.Cells.Select()
objWorkSheet2.Cells.Copy()
objWorkSheet2.Range("A1").PasteSpecial(XlPasteType.xlPasteValuesAndNumberF ormats, XlPasteSpecialOperation.xlPasteSpecialOperationNon e)


'Remove the distanced column
For t = 1 To objWorkSheet2.UsedRange.Columns.Count
If objWorkSheet2.Cells(3, t).NumberFormat.ToString = "@" Then
For j = 1 To t - 1
objWorkSheet2.Columns(1).delete()
Next
End If
Next


objWorkSheet2.Cells(2, 1).value = "Date_and_time"


For k = 1 To 5
If objWorkSheet2.Cells(2, 2).value <> "LAT" Then
objWorkSheet2.Columns(2).delete()
Else
Exit For
End If
Next


'Insert Column for Perf DB
objWorkSheet2.Columns(1).Insert()
objWorkSheet2.Columns(1).Insert()
objWorkSheet2.Columns(1).Insert()
objWorkSheet2.Columns(1).Insert()
objWorkSheet2.Columns(1).Insert()


'Add Name for new Columns
objWorkSheet2.Cells(2, 1).Value = "persian_year"
objWorkSheet2.Cells(2, 2).value = "quarter"
objWorkSheet2.Cells(2, 3).value = "received_date"
objWorkSheet2.Cells(2, 4).value = "persian_village"
objWorkSheet2.Cells(2, 5).value = "english_village"


objWorkSheet2.Rows(1).delete()
Dim xx As Integer = objWorkSheet2.UsedRange.Rows.Count
objWorkSheet2.Range("A2:A" & xx).Value = cmBox_PersianYear.SelectedItem
objWorkSheet2.Range("B2:B" & xx).Value = cmBox_Quarters.SelectedItem
objWorkSheet2.Range("C2:C" & xx).Value = txt_Received_Date.Text
objWorkSheet2.Range("D2:D" & xx).Value = VillageName

'Ready to next excel file
objWorkBook1.Close(SaveChanges:=True)
System.Runtime.InteropServices.Marshal.ReleaseComO bject(objWorkBook1)
objWorkBook1 = Nothing
System.Runtime.InteropServices.Marshal.ReleaseComO bject(objWorkSheet1)
objWorkSheet1 = Nothing
System.Runtime.InteropServices.Marshal.ReleaseComO bject(objWorkSheet2)
objWorkSheet2 = Nothing

ProgressBar1.Value = IIf(lst_FilesEdit.Items.Count = 0, 0, Math.Round(100.0 * FileCount / lst_FilesEdit.Items.Count))
Label3.Text = "Please Wait... (" & ProgressBar1.Value.ToString() & "%)"
FileCount = FileCount + 1
My.Application.DoEvents()
'End If
Next

'Save Village Name for Duplicate Name
Dim file As System.IO.StreamWriter
file = My.Computer.FileSystem.OpenTextFileWriter(txt_Path Browse.Text & "\VillageName-" & txt_Received_Date.Text & ".txt", True)
For ii = 0 To AllVillageName.Count - 1
file.WriteLine(AllVillageName(ii))
Next
file.Close()

objExcel1.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComO bject(objExcel1)
objExcel1 = Nothing

Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub


اگه دقت کنید من Nothing کردن اون اشیاء objWorkBook1 و objWorkSheet1 و objWorkSheet2 رو داخل حلقه انجام میدم، چون داخل حلقه اشیاء جدید با هر تکرار حلقه ایجاد میشن، بیرون حلقه که دیگه مقادیر قبلی از دست رفتن و فایده نداره.

[boveiryghasem]

به به عالی و بی هیچ مشکلی برنامه اجرا شد، دستت درد نکنه.:قلب: