subscript out of range mistake

2019-08-15 07:41发布

站内问答 / 后端开发
1535 0 6

I have main folder and it has subfolders. Every subfolder has four file named as bcst-subfoldername, pcpt-subfoldername, corsi-subfoldername, SCL-subfolder name. And I want to take information these files from prepared excel book. I take subscript out of range mistake "run time error 9" where bold type in code. How can I make it work or my logic is true ?

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

0条回答
登录 后发表回答
相关问题
查看全部
相关文章
查看全部
收藏的人(6)