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

سلام

یه برنامه دارم که توی یک 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.

نقل قول:

---

نوشته شده توسط 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.

---

اشیاء مدیریت شده داخل 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 خالی کنید.

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

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

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

    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  .xlPasteValuesAndNumberFormats, 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  .xlPasteValuesAndNumberFormats, 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

خوب اول تا یادم نرفته بگم که در 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  .xlPasteValuesAndNumberFormats, 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  .xlPasteValuesAndNumberFormats, 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 رو داخل حلقه انجام میدم، چون داخل حلقه اشیاء جدید با هر تکرار حلقه ایجاد میشن، بیرون حلقه که دیگه مقادیر قبلی از دست رفتن و فایده نداره.

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