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