运行数月的VBA代码突发Runtime error 91错误排查求助

一段已稳定运行数月的VBA代码，近期在执行.Top = rngCell.Top语句时突然触发Runtime error 91: Object Variable or With Block Variable not set错误。该代码用于遍历指定文件夹内的PDF文件，根据文件名前缀将其作为OLE对象插入到ActiveSheet的对应单元格位置；出错时，首个PDF会错位到表格底部。

相关代码 #

sFileName = Dir(strInitialFolder & "*.pdf") 
Do While Len(sFileName) > 0 
    If Right(sFileName, 3) = "pdf" Then 
        Select Case Left(sFileName, 3) 
            Case "HCM" 
                Set rngCell = ActiveSheet.Range("B25") 
                sCaption = "HCM_Summary_PDF" 
            Case "CTS" 
                Set rngCell = ActiveSheet.Range("C25") 
                sCaption = "CTS_Summary_PDF" 
        End Select
        Set objOLE = ActiveSheet.OLEObjects.Add(Filename:=strInitialFolder & sFileName, Link:=False, DisplayAsIcon:=True, _ 
            IconFileName:=icoPDF, IconIndex:=0, IconLabel:=sFileName) 
        
        With objOLE 
            .name = sCaption 
            .Top = rngCell.Top 
            .Left = rngCell.Left '.Verb 
        End With 
    End If
 'Set the fileName to the next available file
        sFileName = Dir
    Loop

效果截图 #

正常运行效果：

出错时效果：

问题原因 #

Runtime Error 91的核心诱因是rngCell对象未被正确赋值：

• 代码中仅针对文件名前缀为"HCM"或"CTS"的PDF文件设置rngCell；
• 若文件夹中存在前缀既非"HCM"也非"CTS"的PDF文件，rngCell会保持未初始化状态；
• 后续执行.Top = rngCell.Top时，因访问未赋值的对象变量触发错误；
• 错误发生前插入的OLE对象因未执行定位代码，默认放置在工作表底部，导致错位。

解决方案 #

1. 补充Case Else分支，过滤不符合前缀的文件
   在Select Case中添加分支，直接跳过不匹配的PDF，避免进入后续对象操作：

Select Case Left(sFileName, 3)
    Case "HCM"
        Set rngCell = ActiveSheet.Range("B25")
        sCaption = "HCM_Summary_PDF"
    Case "CTS"
        Set rngCell = ActiveSheet.Range("C25")
        sCaption = "CTS_Summary_PDF"
    Case Else
        ' 跳过当前不匹配的文件，直接进入下一次循环
        GoTo NextFile
End Select

需在循环末尾添加标签：

NextFile:
sFileName = Dir

2. 增加对象空值判断，防御性编程
   在操作rngCell前检查是否已赋值，避免触发错误，同时可清理错误插入的对象：

Set objOLE = ActiveSheet.OLEObjects.Add(Filename:=strInitialFolder & sFileName, Link:=False, DisplayAsIcon:=True, _ 
    IconFileName:=icoPDF, IconIndex:=0, IconLabel:=sFileName) 

If Not rngCell Is Nothing Then
    With objOLE 
        .name = sCaption 
        .Top = rngCell.Top 
        .Left = rngCell.Left 
    End With 
Else
    ' 删除未正确定位的OLE对象，并提示用户
    objOLE.Delete
    MsgBox "文件" & sFileName & "前缀不匹配，已跳过"
End If

3. 优化后缀判断逻辑
   将原有的后缀判断Right(sFileName, 3) = "pdf"替换为LCase(Right(sFileName, 4)) = ".pdf"，兼容大小写差异（如.PDF）和完整后缀格式：

If LCase(Right(sFileName, 4)) = ".pdf" Then

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