在vba中使用ADODB运行连续的数据库查询

我对vba很陌生（就像今天早上），所以这很可能是一个愚蠢的错误。我正在构建一个宏，它使用ADODB从数据库中提取信息，并用信息自动填充附加表单。我的基本设置如下：

Private Sub BuildButton_Click()

'Declare Variables'
Dim con

'Connect to the Database'
Set con = CreateObject("ADODB.Connection")
With con
    .ConnectionString = "DRIVER=SQLServer;SERVER=...;database=...;"
End With

con.Open
Set result = CreateObject("ADODB.Recordset")

'Defining Query Keys'
Family = "'" & FamilyBox.Value & "'"
Rating = "'" & RatingBox.Value & "'"

'SQL Queries'
Query1 = "SELECT ... "
Query2 = "SELECT ... "

'Query #1'
result.Open Query1, con

Do Until result.EOF
    Range("D4").Value = Tier(result.Fields(0).Value)
    result.MoveNext
Loop

'Query #2'
result.Open Query2, con
Do Until result.EOF
    Range("D6").Value = result.Fields(0).Value
    Range("H9").Value = result.Fields(1).Value
    Range("H8").Value = Contact(result.Fields(1).Value)
Loop

它在第一次查询中工作正常，但在“result.Open Query2，con”行中出现错误，显示：

Run-time error '3705'
Operation is not allowed when the object is open.

这对我来说是有道理的，但我很难找到正确的方法

我尝试过的其他事情：

将“result.Open Query2，con”更改为“result Query2，con”，这会产生错误：

Compile error:
Expected Sub, Function, or Property

Run-time error '-2147417848 (80010108)':
Method 'Value' of object 'Range' failed

在两个查询之间添加一行“result.Close”，以便再次打开。这会使程序崩溃并产生错误：

Compile error:
Expected Sub, Function, or Property

Run-time error '-2147417848 (80010108)':
Method 'Value' of object 'Range' failed

看起来这应该是一个简单的解决方案，我只是被卡住了。感谢您的帮助

---

更新

Option Explicit

Private Sub BuildButton_Click()

'Declare Variables'
Dim con As ADODB.Connection, result As ADODB.Recordset
Dim Family As String, Rating As String, Query1 As String, Query2 As String

'Connect to the Database'
Set con = CreateObject("ADODB.Connection")
With con
    .ConnectionString = "DRIVER=SQLServer;SERVER=...;database=...;"
End With

con.Open
Set result = CreateObject("ADODB.Recordset")

'Defining Query Keys'
Family = "'" & FamilyBox.Value & "'"
Rating = "'" & RatingBox.Value & "'"

'SQL Queries'
Query1 = "SELECT ... "
Query2 = "SELECT ... "

'Query #1'
result.Open Query1, con

Do Until result.EOF
    Range("D4").Value = Tier(result.Fields(0).Value)
    result.MoveNext
Loop

result.Close
Set result = CreateObject("ADODB.Recordset")

'Query #2'
result.Open Query2, con
Do Until result.EOF
    Range("D6").Value = result.Fields(0).Value
    Range("H9").Value = result.Fields(1).Value
    Range("H8").Value = Contact(result.Fields(1).Value)
Loop

---

除了在打开之间添加result.Close命令（如注释中所述），我只是忘记了第二个循环中的result.MoveNext。因为结果从未移动到下一行，所以它从未到达EOF，并导致无限循环

完整的解决方案：

更改：

'Query #1'
result.Open Query1, con

Do Until result.EOF
    Range("D4").Value = Tier(result.Fields(0).Value)
    result.MoveNext
Loop

'Query #2'
result.Open Query2, con
Do Until result.EOF
    Range("D6").Value = result.Fields(0).Value
    Range("H9").Value = result.Fields(1).Value
    Range("H8").Value = Contact(result.Fields(1).Value)
Loop

进入：

---

您是否也在关闭后但在打开之前包含了“Set result=CreateObject”（“ADODB.Recordset”）？还有，你有什么理由不想将变量设置为应该的类型？我没有，但只是尝试了一下，它给出了与没有一样的错误。你能发布实际的代码（减去任何密码等）吗？有时会有打字错误。此外，我建议有一个明确的选择。您在哪里执行此代码-Excel？您需要

结果。运行每个查询后关闭
。如果记录集已处于该状态，则无法对其调用
Open
。@WayneG.Dunn我不确定如何发布代码，但它已复制并粘贴，因此应该可以。哪一行给出错误？？？？我正准备说我让你的代码工作了。我添加了“Close”和“MoveNext”，并定义了所有变量。但是，由于您的“范围”是硬编码的，所以您似乎只使用了几个单元格？当然，我们无法知道您是否只选择了一条记录，因为我们无法看到您的SQL。还有，你有没有尝试过“Option Explicit”和编译？？？现在没有人给出错误，我用close和MoveNext解决了这个问题。该范围是硬编码的，因为电子表格是一个提交表单，有大约一百个字段需要美观地填写，但不幸的是，没有特定的模式我可以循环。我确实做了明确的选择，检查问题的最后两条评论。