下标超出范围错误

我有主文件夹，它有子文件夹。 每个子文件夹都有四个文件，分别命名为bcst-subfoldername，pcpt-subfoldername，corsi-subfoldername，SCL-subfolder名称。 我想从准备好的Excel书中获取这些文件的信息。 我把下标超出范围的错误“运行时错误9”放在代码中的粗体中。 我怎样才能使它工作，或我的逻辑是真实的？

Function GetFolder() As String Dim fldr As FileDialog Dim sItem As String Set fldr = Application.FileDialog(msoFileDialogFolderPicker) With fldr .Title = "Bİr dosya seçiniz" .AllowMultiSelect = False .InitialFileName = Application.DefaultFilePath If .Show <> -1 Then GoTo NextCode sItem = .SelectedItems(1) End With NextCode: GetFolder = sItem Set fldr = Nothing End Function Function Recurse(sPath As String) As String Dim FSO As New FileSystemObject Dim myFolder As Folder Dim mySubFolder As Folder Dim myFile As File Set myFolder = FSO.GetFolder(sPath) Dim Str As String Dim sItem2 As String Dim sItem3 As String Dim sItem4 As String Dim sItem5 As String Dim sItem6 As String Dim sItem7 As String Dim sItem8 As String Dim sItem9 As String Dim sItem10 As String Dim sItem11 As String Dim sItem12 As String Dim finalString As String Dim finalString2 As String Dim finalString3 As String Dim finalString4 As String Dim finalString5 As String Dim finalString6 As String Dim finalString7 As String Dim finalString8 As String Dim finalString9 As String Dim finalString10 As String Dim finalString11 As String Dim indexOfChar As Integer Dim indexOfChar2 As Integer Dim indexOfChar3 As Integer Dim indexOfChar4 As Integer Dim indexOfChar5 As Integer Dim indexOfChar6 As Integer Dim indexOfChar7 As Integer Dim indexOfChar8 As Integer Dim indexOfChar9 As Integer Dim indexOfChar10 As Integer Dim indexOfChar11 As Integer For Each mySubFolder In myFolder.SubFolders Application.ScreenUpdating = False Set ana = Workbooks.Open("C:\Users\Burak\Desktop\2MacroDegerlendirme.xlsm").Sheets("Sayfa1") 'Hangi sayfaya alınacak? For Each myFile In mySubFolder.Files Str = myFile.Name If InStr(Str, "bcst") >= 0 Then Set dosya = Workbooks.Open(mySubFolder & "\" & Str) 'Alınacak dosyanın uzantısı ne? sItem2 = dosya.Sheets(ActiveSheet.Name).Range("A4") indexOfChar = InStr(1, sItem2, ":") finalString = Right(sItem2, Len(sItem2) - indexOfChar) ana.Range("F7") = finalString & "." 'Hangi sayfanın hangi hücresi nereye alınacak? sItem3 = dosya.Sheets(ActiveSheet.Name).Range("A5") indexOfChar2 = InStr(1, sItem3, ":") finalString2 = Right(sItem3, Len(sItem3) - indexOfChar2) ana.Range("F8") = finalString2 'Hangi sayfanın hangi hücresi nereye alınacak? sItem4 = dosya.Sheets(ActiveSheet.Name).Range("A7") indexOfChar3 = InStr(1, sItem4, ":") finalString3 = Right(sItem4, Len(sItem4) - indexOfChar3) ana.Range("F9") = finalString3 'Hangi sayfanın hangi hücresi nereye alınacak? sItem5 = dosya.Sheets(ActiveSheet.Name).Range("A6") indexOfChar4 = InStr(1, sItem5, ":") finalString4 = Right(sItem5, Len(sItem5) - indexOfChar4) ana.Range("F10") = finalString4 'Hangi sayfanın hangi hücresi nereye alınacak? sItem6 = dosya.Sheets(ActiveSheet.Name).Range("A8") indexOfChar5 = InStr(1, sItem6, ":") finalString5 = Right(sItem6, Len(sItem6) - indexOfChar5) ana.Range("F11") = finalString5 'Hangi sayfanın hangi hücresi nereye alınacak? sItem7 = dosya.Sheets(ActiveSheet.Name).Range("A11") indexOfChar6 = InStr(1, sItem7, ":") finalString6 = Right(sItem7, Len(sItem7) - indexOfChar6) ana.Range("F12") = finalString6 'Hangi sayfanın hangi hücresi nereye alınacak? dosya.Close Application.ScreenUpdating = True ThisWorkbook.Save End If If InStr(Str, "ptrails") >= 0 Then Set dosya = Workbooks.Open(mySubFolder & "\" & Str) sItem2 = dosya.Sheets(ActiveSheet.Name).Range("A18") indexOfChar = InStr(1, sItem2, ":") finalString = Right(sItem2, Len(sItem2) - indexOfChar) ana.Range("B7") = finalString & "." 'Hangi sayfanın hangi hücresi nereye alınacak? sItem3 = dosya.Sheets(ActiveSheet.Name).Range("A19") indexOfChar2 = InStr(1, sItem3, ":") finalString2 = Right(sItem3, Len(sItem3) - indexOfChar2) MsgBox finalString ana.Range("B8") = finalString2 'Hangi sayfanın hangi hücresi nereye alınacak? sItem4 = dosya.Sheets(ActiveSheet.Name).Range("A16") indexOfChar3 = InStr(1, sItem4, ":") finalString3 = Right(sItem4, Len(sItem4) - indexOfChar3) ana.Range("B9") = finalString3 'Hangi sayfanın hangi hücresi nereye alınacak? sItem5 = dosya.Sheets(ActiveSheet.Name).Range("A34") indexOfChar4 = InStr(1, sItem5, ":") finalString4 = Right(sItem5, Len(sItem5) - indexOfChar4) ana.Range("B10") = finalString4 'Hangi sayfanın hangi hücresi nereye alınacak? sItem6 = dosya.Sheets(ActiveSheet.Name).Range("A35") indexOfChar5 = InStr(1, sItem6, ":") finalString5 = Right(sItem6, Len(sItem6) - indexOfChar5) ana.Range("B11") = finalString5 'Hangi sayfanın hangi hücresi nereye alınacak? sItem7 = dosya.Sheets(ActiveSheet.Name).Range("A32") indexOfChar6 = InStr(1, sItem7, ":") finalString6 = Right(sItem7, Len(sItem7) - indexOfChar6) ana.Range("B12") = finalString6 'Hangi sayfanın hangi hücresi nereye alınacak? sItem8 = dosya.Sheets(ActiveSheet.Name).Range("A50") indexOfChar7 = InStr(1, sItem8, ":") finalString7 = Right(sItem8, Len(sItem8) - indexOfChar7) ana.Range("B13") = finalString7 'Hangi sayfanın hangi hücresi nereye alınacak? sItem9 = dosya.Sheets(ActiveSheet.Name).Range("A51") indexOfChar8 = InStr(1, sItem9, ":") finalString8 = Right(sItem9, Len(sItem9) - indexOfChar8) ana.Range("B14") = finalString8 'Hangi sayfanın hangi hücresi nereye alınacak? sItem10 = dosya.Sheets(ActiveSheet.Name).Range("A48") indexOfChar9 = InStr(1, sItem10, ":") finalString9 = Right(sItem10, Len(sItem10) - indexOfChar9) ana.Range("B15") = finalString9 'Hangi sayfanın hangi hücresi nereye alınacak? dosya.Close Application.ScreenUpdating = True ThisWorkbook.Save End If If InStr(Str, "SCL") >= 0 Then Set dosya = Workbooks.Open(mySubFolder & "\" & Str) **sItem2 = dosya.Sheets("dd").Range("C3")** indexOfChar = InStr(1, sItem2, ":") finalString = Right(sItem2, Len(sItem2) - indexOfChar) ana.Range("E16") = finalString & "." 'Hangi sayfanın hangi hücresi nereye alınacak? sItem3 = dosya.Sheets("Değerlendirme").Range("C4") indexOfChar2 = InStr(1, sItem3, ":") finalString2 = Right(sItem3, Len(sItem3) - indexOfChar2) ana.Range("E17") = finalString2 'Hangi sayfanın hangi hücresi nereye alınacak? sItem4 = dosya.Sheets("Değerlendirme").Range("C5") indexOfChar3 = InStr(1, sItem4, ":") finalString3 = Right(sItem4, Len(sItem4) - indexOfChar3) ana.Range("E18") = finalString3 'Hangi sayfanın hangi hücresi nereye alınacak? sItem5 = dosya.Sheets("Değerlendirme").Range("C6") indexOfChar4 = InStr(1, sItem5, ":") finalString4 = Right(sItem5, Len(sItem5) - indexOfChar4) ana.Range("E19") = finalString4 'Hangi sayfanın hangi hücresi nereye alınacak? sItem6 = dosya.Sheets("Değerlendirme").Range("C7") indexOfChar5 = InStr(1, sItem6, ":") finalString5 = Right(sItem6, Len(sItem6) - indexOfChar5) ana.Range("E20") = finalString5 'Hangi sayfanın hangi hücresi nereye alınacak? sItem7 = dosya.Sheets("Değerlendirme").Range("C8") indexOfChar6 = InStr(1, sItem7, ":") finalString6 = Right(sItem7, Len(sItem7) - indexOfChar6) ana.Range("E21") = finalString6 'Hangi sayfanın hangi hücresi nereye alınacak? sItem8 = dosya.Sheets("Değerlendirme").Range("C9") indexOfChar7 = InStr(1, sItem8, ":") finalString7 = Right(sItem8, Len(sItem8) - indexOfChar7) ana.Range("E22") = finalString7 'Hangi sayfanın hangi hücresi nereye alınacak? sItem9 = dosya.Sheets("Değerlendirme").Range("C10") indexOfChar8 = InStr(1, sItem9, ":") finalString8 = Right(sItem9, Len(sItem9) - indexOfChar8) ana.Range("E23") = finalString8 'Hangi sayfanın hangi hücresi nereye alınacak? sItem10 = dosya.Sheets("Değerlendirme").Range("C11") indexOfChar9 = InStr(1, sItem10, ":") finalString9 = Right(sItem10, Len(sItem10) - indexOfChar9) ana.Range("E24") = finalString9 'Hangi sayfanın hangi hücresi nereye alınacak? sItem11 = dosya.Sheets("Değerlendirme").Range("C12") indexOfChar10 = InStr(1, sItem11, ":") finalString10 = Right(sItem11, Len(sItem11) - indexOfChar10) ana.Range("E25") = finalString10 'Hangi sayfanın hangi hücresi nereye alınacak? sItem12 = dosya.Sheets("Değerlendirme").Range("C13") indexOfChar11 = InStr(1, sItem12, ":") finalString11 = Right(sItem12, Len(sItem12) - indexOfChar11) ana.Range("E26") = finalString11 'Hangi sayfanın hangi hücresi nereye alınacak? dosya.Close Application.ScreenUpdating = True ThisWorkbook.Save End If If InStr(Str, "corsi") >= 0 Then Set dosya = Workbooks.Open(mySubFolder & "\" & Str) sItem2 = dosya.Sheets(ActiveSheet.Name).Range("A7") indexOfChar = InStr(1, sItem2, ":") finalString = Right(sItem2, Len(sItem2) - indexOfChar) ana.Range("B19") = finalString & "." 'Hangi sayfanın hangi hücresi nereye alınacak? sItem3 = dosya.Sheets(ActiveSheet.Name).Range("A6") indexOfChar2 = InStr(1, sItem3, ":") finalString2 = Right(sItem3, Len(sItem3) - indexOfChar2) ana.Range("B20") = finalString2 'Hangi sayfanın hangi hücresi nereye alınacak? sItem4 = dosya.Sheets(ActiveSheet.Name).Range("A17") indexOfChar3 = InStr(1, sItem4, ":") finalString3 = Right(sItem4, Len(sItem4) - indexOfChar3) ana.Range("B21") = finalString3 'Hangi sayfanın hangi hücresi nereye alınacak? sItem5 = dosya.Sheets(ActiveSheet.Name).Range("A16") indexOfChar4 = InStr(1, sItem5, ":") finalString4 = Right(sItem5, Len(sItem5) - indexOfChar4) ana.Range("B22") = finalString4 'Hangi sayfanın hangi hücresi nereye alınacak? ThisWorkbook.Save End If If InStr(Str, "pcpt") >= 0 Then Set dosya = Workbooks.Open(mySubFolder & "\" & Str) Dim i As Integer Dim correct As Integer Dim miss As Integer miss = 0 incorrect = 0 For i = 2 To 243 If Cells(i, 6).Value = 0 And Cells(i, 7).Value = 0 Then miss = miss + 1 ElseIf Cells(i, 6).Value = 1 And Cells(i, 7).Value = 0 Then incorrect = incorrect + 1 End If Next i ana.Range("B24") = incorrect ana.Range("B25") = miss dosya.Close Application.ScreenUpdating = True ThisWorkbook.Save End If Exit For Next Recurse = Recurse(mySubFolder.Path) Next End Function Sub TestR() Call Recurse(GetFolder) End Sub