Question

我的代码正在尝试遍历列并打开该列中的相关文件路径。出于某种原因在第二个循环中虽然代码落在了

运行时错误'9'：下标超出范围

文件路径是正确的，它似乎没有一致的错误，所以我很难找出原因。尝试通过循环第二次分配ExcelFilePath时出现代码错误。

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

提前致谢

Answer 1

尝试像这样更改您的代码

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

或甚至更好地传递正确的工作表

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

循环文件路径并打开excel时出现运行时错误9

1 个答案: