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

Question

我对 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.

这对我来说很有意义，但我无法找出正确的方法。

我尝试过的其他事情：

1. 将“result.Open Query2, con”更改为“result Query2, con”，出现错误：

   Compile error:
   Expected Sub, Function, or Property
   

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

   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

Answer 1

除了在 cmets 中所说的在打开之间添加 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

进入：

'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)
    **result.MoveNext**
Loop