循环读取文件路径打开Excel时触发Run-time error '9'问题求助

我来帮你揪出这个Run-time error '9'的元凶！根据你描述的情况——第二次循环给ExcelFilePath赋值时出错，且所有文件路径都正确，最可能的问题是工作簿引用错位，具体分析和修复方案如下：

核心原因：活动工作簿切换导致工作表引用失效 #

当你第一次调用Workbooks.Open打开新文件后，Excel的活动工作簿会自动切换到刚打开的文件。而你的代码里Sheets(sHt)没有明确指定所属的工作簿，默认会去当前活动工作簿里找名为sHt的工作表。如果新打开的文件里没有这个工作表，自然就触发了「下标越界」错误。

修复方案：明确引用原工作簿 #

修改OpenExcels函数，先保存原工作簿的固定引用，后续所有对工作表、行的操作都基于这个引用，彻底避免活动工作簿切换带来的错位问题：

Function OpenExcels(sHt As String) As Object
    Dim J As Long ' 改用Long避免行数超过32767时溢出
    Dim ExcelFilePath As String
    Dim PathLastRow As Long
    Dim sourceWb As Workbook ' 保存原工作簿的固定引用
    
    ' 保存代码所在的原工作簿（如果你的数据在其他工作簿，可替换为对应引用）
    Set sourceWb = ThisWorkbook
    
    ' 基于原工作簿获取最后一行和单元格值
    PathLastRow = sourceWb.Sheets(sHt).Range("R" & sourceWb.Rows.Count).End(xlUp).Row
    For J = 6 To PathLastRow
        ' 明确从原工作簿的指定工作表读取路径
        ExcelFilePath = sourceWb.Sheets(sHt).Range("R" & J).Value
        Module1.OpenExcelCheck ExcelFilePath
    Next J
End Function

额外优化建议 #

1. 提升IsWorkBookOpen的准确性：当前函数仅通过文件名判断，若存在同名不同路径的文件会误判。可以修改为通过完整路径匹配：

Function IsWorkBookOpen(fullPath As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    ' 先尝试直接通过完整路径匹配
    Set xWb = Application.Workbooks(fullPath)
    ' 若直接匹配失败，遍历所有打开的工作簿检查FullName
    If xWb Is Nothing Then
        For Each xWb In Application.Workbooks
            If StrComp(xWb.FullName, fullPath, vbTextCompare) = 0 Then
                IsWorkBookOpen = True
                Exit Function
            End If
        Next xWb
        IsWorkBookOpen = False
    Else
        IsWorkBookOpen = True
    End If
    On Error GoTo 0
End Function

调用时直接传入完整路径即可：xRet = IsWorkBookOpen(myPath)

2. 替换Integer为Long类型：Excel的行数上限远大于Integer的32767，改用Long存储行号能避免溢出风险。

这样修改后，应该就能解决第二次循环的下标越界问题了！

内容的提问来源于stack exchange，提问作者TisButaScratch