嘿，这个Run-time error '-2147417848 (80010108)'错误通常和资源泄漏、未正确释放ADODB对象或者文件访问冲突有关，结合你的代码来看，我整理了几个关键的修复点：

1. 修复资源管理：确保ADODB对象无论成功/失败都能被释放 #

你的代码里虽然有rs.Close和objCon.Close，但如果在rs.Open之前就出错，这些清理代码不会执行，导致连接/记录集资源残留，影响后续循环。建议添加错误处理块，强制清理资源：

修改循环内的ADODB对象处理部分：

' 把循环内的ADODB创建和查询逻辑用错误包裹
Set objCon = New ADODB.Connection
Set rs = New ADODB.Recordset

On Error GoTo Cleanup ' 出错时跳转到清理逻辑

With objCon
    .ConnectionTimeout = 30 ' 建议设一个合理超时，0可能导致无响应
    .CommandTimeout = 30
    .Open strConString
End With

' ... 你的SQL查询构建 ...

If rs.State = adStateOpen Then rs.Close
rs.Open strQuery, objCon, adOpenStatic, adLockBatchOptimistic

' ... 后续的文件生成逻辑 ...

Cleanup:
' 确保无论是否出错，都关闭并释放对象
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing
If objCon.State = adStateOpen Then objCon.Close
Set objCon = Nothing
On Error GoTo 0 ' 重置错误处理

2. 优化连接复用：避免循环内重复创建/关闭连接 #

每次循环都新建连接会增加资源开销，而且容易导致连接泄漏。可以把连接移到循环外面，只打开一次，循环内复用：

Sub ReceivedReports(ByVal strConString As String)
    Dim intA As Integer, intB As Integer, intRecCount As Double
    Dim lngRecCount As Long
    Dim objCon As ADODB.Connection ' 移到循环外声明
    Dim rs As ADODB.Recordset ' 移到循环外声明
    
    'Generate Despatch Pending Files
    Pending_Date = Format(Date - 1, "DD-MMM-YYYY")
    strRegionCode = "APRSTSKL0102KAMHMPNRUP"
    intCount = Len(strRegionCode) / 2

    ' 提前打开连接
    Set objCon = New ADODB.Connection
    With objCon
        .ConnectionTimeout = 30
        .CommandTimeout = 30
        .Open strConString
    End With

    On Error GoTo ConnectionCleanup ' 全局错误处理

    For IntI = 1 To intCount
        StrRegion = Mid(strRegionCode, (IntI * 2) - 1, 2)
        If StrRegion = "01" Then
            StrRegion = "TN01"
        End If
        If StrRegion = "02" Then
            StrRegion = "TN02"
        End If

        Set rs = New ADODB.Recordset
        On Error Resume Next ' 局部错误处理，避免单个循环出错终止整个宏
        If rs.State = adStateOpen Then rs.Close
        On Error GoTo 0

        ' ... SQL查询构建 ...

        rs.Open strQuery, objCon, adOpenStatic, adLockBatchOptimistic

        lngRecCount = rs.RecordCount
        If lngRecCount > 0 Then
            ' ... 文件生成逻辑 ...
        End If

        ' 清理当前循环的记录集
        If rs.State = adStateOpen Then rs.Close
        Set rs = Nothing
    Next IntI

ConnectionCleanup:
' 最终清理连接
If objCon.State = adStateOpen Then objCon.Close
Set objCon = Nothing
MsgBox "宏执行完成！", vbInformation
End Sub

3. 避免隐式变量和ActiveSheet依赖 #

你的代码里TargetFile、Pending_Date等变量没有用Dim声明，属于隐式变量，容易导致意外错误。另外，ActiveSheet可能会因为用户操作或者宏的其他部分切换工作表，建议明确引用工作表对象：

比如把：

With ActiveSheet
    .Cells.Font.Size = 10
    .Cells.Font.Name = "Verdana"
End With

改成：

With newWbk.Sheets("Sheet1")
    .Cells.Font.Size = 10
    .Cells.Font.Name = "Verdana"
End With

4. 处理RecordCount的不确定性 #

adOpenStatic游标虽然支持RecordCount，但某些情况下（比如源数据量很大）可能返回-1，建议用rs.EOF来判断是否有数据，而不是依赖RecordCount：

' 替换原来的If rs.RecordCount > 0 Then
If Not rs.EOF Then
    ' ... 文件生成逻辑 ...
End If

额外建议 #

• 确保源Excel文件在宏运行时没有被其他程序锁定（比如手动打开着）
• 生成的目标文件路径尽量避免特殊字符，确保权限足够写入
• 可以在循环中加入短暂延迟（Application.Wait Now + TimeValue("00:00:01")），避免频繁访问文件导致冲突

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