Excel VBA：ODBC SQL 服务器驱动程序查询超时已过期

Question

我在 Excel 2016 中使用了以下 VBA 查询，该查询执行 MS Sql 存储过程，有时它可以顺利执行并返回记录集，但更多时候我收到错误 [Microsoft][ODBC SQL Server Driver] query timeout expired。

同时，当我们转到 SSMS 并执行查询时，它运行没有问题。

这假定问题是由 Excel/VB 引起的，而不是由 SQL 或查询本身引起的。

搜索此错误导致检查网络防火墙，但我们在没有防火墙的其他机器上尝试过，问题仍然存在。

这是VB代码：

    Public Sub GetDataset2()

    Dim cn As ADODB.Connection
    Dim cm As Object
    Dim rs As ADODB.Recordset
    Dim UID, PWD, DB As String
    UID = "userId"
    PWD = "passworD"
    DB = "192.168.1.1"

    Set cn = New ADODB.Connection
    Set cm = CreateObject("ADODB.Command")

    cm.CommandTimeout = 0
    cn.Open ("Driver={SQL Server};Server=" & DB & ";Database=myDatabaseName;Trusted_Connection=no;Timeout=900;Uid=" & UID & ";Pwd=" & PWD)
    Set rs = cn.Execute("Get_dataset2 '" & Format(Range("dateFrom"), "yyyy-mm-dd") & "' ,'" & Format(Range("dateTo"), "yyyy-mm-dd") & "' ")

Dim lRow As Long

'Find the last non-blank cell in column A(1)
    lRow = Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row
    lr = "A" & lRow + 1
        Sheets("data").Range(lr).CopyFromRecordset rs  'insert data

cn.Close

End Sub

感谢任何建议。 乔尔

Answer 1

在对我之前回答的问题和 cmets 进行了更多思考之后，这里有一些额外的观点。对于 BitAccesser，cn.CommandTimeout 与Connection.CommandTimeout 相同，因为最初提交的代码已经标注了尺寸并将cn 对象设置为ADODB.Connection。另外值得注意的是ConnectionTimeout 和CommandTimeout 之间的区别。连接超时是网络级别，而命令超时是 SQL Server 级别。在这种情况下，即使实例化了 ADODB.Command 对象，也不会使用它。另一点与连接字符串有关。连接超时可以在连接字符串中引用，但通常不使用。连接将默认为 15 秒。因此，值得明确地重置这些属性。

    Cn.CommandTimeout = 50
    Cn.ConnectionTimeout = 50

Answer 2

一种可能的解决方案是延长连接命令超时值。您当前脚本的值设置为 0。这可以增加。在 SSMS 中运行查询应该可以让您大致了解完成查询所需的时间。然后，相应地调整该值。

    cm.CommandTimeout = 100

Answer 3

经过数周的各种代码更改测试，我们发现将 SQL 调用更改为 QueryTable 方法而不是 CopyFromRecordset 方法时，它工作正常。

所以如果以后有人需要，我会粘贴代码。

Sub GetDataset3()

Dim cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim UID, PWD, SRV As String
UID = "userId"
PWD = "passworD"
SRV = "192.168.1.1"

If Sheets("data").QueryTables.Count = 0 Then
     Sheets("data").Cells.Select
     Selection.ClearContents

     Dim Str As String 'adds backround query
     Str = ""
     For Each cell In Range("A1:A10").Cells
     Str = Str & Chr(10) & cell
    Next

      With Sheets("data").QueryTables.Add(Connection:="ODBC;UID=;PWD=;DRIVER=SQL 
        Server;SERVER=SRV", Destination:=Range("a2"))
        .CommandText = "select 1"
        'BackgroundQuery = True
        '.Refresh BackgroundQuery = True
        .FieldNames = False
        .AdjustColumnWidth = False
      End With
End If

 With Sheets("data").QueryTables(1)
   .Connection = "ODBC;DRIVER=SQL Server;SERVER=" & SRV & 
   ";database=myDatabaseName;UID=" & UID & ";Pwd=" & PWD & 
   ";Trusted_Connection=no;APP=Microsoft Office"
   .CommandText = ("Get_dataset2 '" & Range("dateFrom") & "' ,'" & 
    Range("dateTo") & "' ")
    BackgroundQuery = True
    .Refresh BackgroundQuery:=False

 End With

End Sub