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.

这对我有意义，但我无法找到正确的方法来做到这一点。

我尝试过的其他事情：

将“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

除了在注释中添加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

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

1 个答案: