CODEWITHSUNDEEP
vbaexcel
TisButaScratch
TisButaScratch

Reputation: 173

Runtime error 9 when looping through file paths and opening excel

My code is attempting to loop through a column and open the relevant file paths in that column. For some reason on the 2nd loop though the code falls over with an

Run-time error '9': Subscript out of range

The file paths are correct, and it does not seem to error consistently so I am struggling to identify the cause. The code errors when trying to assign the ExcelFilePath the 2nd time through the loop.

Function OpenExcels(sHt As String) As Object
Dim J As Integer
Dim ExcelFilePath As String
Dim PathLastRow As Integer

'Open Excels
    PathLastRow = Sheets(sHt).Range("R" & Rows.Count).End(xlUp).Row

    For J = 6 To PathLastRow

    ExcelFilePath = Sheets(sHt).Range("R" & J).Value 'ERROR HERE

    Module1.OpenExcelCheck ExcelFilePath

    Next J

End Function

Function OpenExcelCheck(myPath As String) As Object
Dim myFileName As String
Dim FolderPath As String
Dim SaveExt As String
Dim xRet As Boolean

    myFileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
    FolderPath = Left(myPath, InStrRev(myPath, "\"))
    SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))

    xRet = IsWorkBookOpen(myFileName & SaveExt)
    If xRet Then

    Else
        Workbooks.Open (myPath)
        Sleep 5000
    End If

End Function

Function IsWorkBookOpen(Name As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xWb Is Nothing)
End Function

Thanks in advance

Upvotes: 0

Views: 43

Answers (1)

Storax
Storax

Reputation: 12167

Try to change your code like this

Function OpenExcels(sHt As String) As Object
Dim J As Integer
Dim ExcelFilePath As String
Dim PathLastRow As Integer
Dim ws as worksheet
set ws = ActiveSheet

'Open Excels
    PathLastRow = ws.Range("R" & Rows.Count).End(xlUp).Row

    For J = 6 To PathLastRow

    ExcelFilePath = ws.Range("R" & J).Value 'ERROR HERE

    Module1.OpenExcelCheck ExcelFilePath

    Next J

End Function

or even better pass the correct worksheet at the beginning

Function OpenExcels(ws as worksheet) As Object
Dim J As Integer
Dim ExcelFilePath As String
Dim PathLastRow As Integer

'Open Excels
    PathLastRow = ws.Range("R" & Rows.Count).End(xlUp).Row

    For J = 6 To PathLastRow

    ExcelFilePath = ws.Range("R" & J).Value 'ERROR HERE

    Module1.OpenExcelCheck ExcelFilePath

    Next J

End Function

Upvotes: 1

Related Questions