Excel VBA循环嵌入数据库查询连接报错：对象已打开的解决问询

老哥，我帮你捋捋这个问题，你遇到的“对象已打开”错误其实是因为资源没管好，再加上几个小语法问题，咱们一步步来解决：

问题根源拆解 #

• 未释放ADODB对象：你每次循环都新建ADODB.Connection和ADODB.Recordset，但用完后没关闭也没释放，这些对象一直占着资源，下次循环再创建就冲突了。
• 重复声明变量：循环里重复Dim xConnect属于不良习惯，容易导致变量状态混乱。
• SQL语法错误：你的SQL语句里CELL2后面缺了连接符&和闭合引号，而且Right(Filename,6)前面没加AND，这会让SQL执行失败，间接加重对象占用问题。
• 无效操作：删除ActiveWorkbook.Connections完全没用，你用的是独立的ADODB连接，和Excel自带的Connections不是一回事。

修复步骤 #

1. 统一管理ADODB对象：要么在循环外创建连接复用，要么每次循环结束强制关闭并释放连接和记录集。
2. 修正SQL语法：补全缺失的连接符、引号和逻辑运算符，确保查询能正常执行。
3. 简化单元格取值：别用Activate和ActiveCell，直接用cell.Value更高效稳定。
4. 移除无效操作：删掉那些没用的Connections删除代码，专注管理自己的ADODB对象。

修正后的完整代码 #

Sub QueryDatabaseForCells()
    Dim cell As Range
    Dim rng As Range
    Dim CELL2 As Variant
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim ConnectionString As String
    Dim StrQuery1 As String
    Dim PathID As Variant
    
    ' 替换成你的实际连接字符串
    ConnectionString = "你的数据库连接信息"
    
    ' 定义要遍历的单元格区域
    Set rng = Range("D9:D" & ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row)
    
    ' 循环外创建连接，复用更高效
    Set cnn = New ADODB.Connection
    cnn.ConnectionTimeout = 900
    cnn.Open ConnectionString
    
    For Each cell In rng.Cells
        CELL2 = cell.Value
        
        ' 修正后的SQL语句：补全语法缺失部分
        StrQuery1 = "Declare @DocID int " & _
                    "Select @DocId = DocumentID from Documents where Left(Filename,10) = '" & CELL2 & "' AND Right(Filename,6) = 'SLDDRW' " & _
                    "Declare @PrjId int " & _
                    "Select @PrjId = ProjectID from DocumentsinProjects where DocumentId = @DocId " & _
                    "Select Path from Projects where ProjectID = @PrjId"
        
        ' 确保记录集关闭后再重新打开
        If Not rst Is Nothing Then
            If rst.State = adStateOpen Then rst.Close
            Set rst = Nothing
        End If
        Set rst = New ADODB.Recordset
        rst.Open StrQuery1, cnn
        
        ' 获取并展示查询结果
        If Not rst.EOF Then
            PathID = rst!Path
            MsgBox "当前单元格内容: " & CELL2
            MsgBox "查询到的路径: " & PathID
        Else
            MsgBox "单元格内容「" & CELL2 & "」未找到匹配路径"
        End If
        
        ' 关闭当前记录集并释放
        rst.Close
        Set rst = Nothing
    Next cell
    
    ' 最后统一关闭连接并释放所有对象
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Sub

额外优化提示 #

如果你的单元格内容可能包含单引号（比如O'Neil），直接拼接SQL会报错，建议用参数化查询避免这个问题，示例片段：

StrQuery1 = "Declare @DocID int " & _
            "Select @DocId = DocumentID from Documents where Left(Filename,10) = ? AND Right(Filename,6) = 'SLDDRW' " & _
            "Declare @PrjId int " & _
            "Select @PrjId = ProjectID from DocumentsinProjects where DocumentId = @DocId " & _
            "Select Path from Projects where ProjectID = @PrjId"
rst.Open StrQuery1, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
rst.Parameters(0) = CELL2

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