Excel VBA：ODBC SQL 服务器驱动程序查询超时已过期
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/44708549/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA: ODBC SQL server driver query timeout expired
提问by joell
I have the below VBA query used in Excel 2016 that exacutes a MS Sql stored procedure, sometimes it executes smoothly and returns the recordset, but more often I get an error [Microsoft][ODBC SQL Server Driver] query timeout expired.
我在 Excel 2016 中使用了以下 VBA 查询，它可以执行 MS Sql 存储过程，有时它可以顺利执行并返回记录集，但更多时候我会收到错误[Microsoft][ODBC SQL Server Driver] query timeout expired。
At the same time when we go to SSMS and execute the query it runs without issues.
同时，当我们转到 SSMS 并执行查询时，它运行没有问题。
This assumes the issue is rather caused by Excel/VB than by SQL or the query itself.
这假设问题是由 Excel/VB 引起的，而不是由 SQL 或查询本身引起的。
Searching for this error results in checking network firewalls, but we tried on other machines without firewalls, problems persists.
搜索这个错误导致检查网络防火墙，但我们在其他没有防火墙的机器上尝试过，问题仍然存在。
Here is the VB code:
这是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
Any suggestion is appreciated. Joel
任何建议表示赞赏。乔尔
回答by Geoffrey Fuller
One possible solution is to lengthen the connection command timeout value. Your current script has the value set to 0. This could be increased. Running the query in SSMS should give you a rough idea of the time needed to complete the query. Then, adjust the value accordingly.
一种可能的解决方案是延长连接命令超时值。您当前的脚本将值设置为 0。这可以增加。在 SSMS 中运行查询应该能让您大致了解完成查询所需的时间。然后，相应地调整值。
cm.CommandTimeout = 100
回答by Geoffrey Fuller
After some more thought about the question and the comments on my prior answer, here are some additional points. To BitAccesser, cn.CommandTimeoutis the same as Connection.CommandTimeoutsince the originally submitted code had already dimensioned and set the cnobject as an ADODB.Connection. Also worth noting is the difference between ConnectionTimeoutand CommandTimeout. The connection timeout is network level, while the command timeout is SQL Server level. In this case, even though a ADODB.Commandobject is instantiated, it isn't used. Another point relates to the connection string. The connection timeout could be referenced in the connection string, but often, is not used. The connection will be defaulted to 15 seconds. So, its worth resetting those attributes explicitly.
在进一步思考这个问题和对我之前的回答的评论之后，这里有一些额外的观点。为了BitAccesser，cn.CommandTimeout是一样的Connection.CommandTimeout，因为最初提交的代码已经尺寸并设置cn对象的ADODB.Connection。另外值得注意的是之间的差异ConnectionTimeout和CommandTimeout。连接超时是网络级别，而命令超时是 SQL Server 级别。在这种情况下，即使ADODB.Command对象被实例化，它也不会被使用。另一点与连接字符串有关。连接超时可以在连接字符串中引用，但通常不使用。连接将默认为 15 秒。因此，值得明确重置这些属性。
Cn.CommandTimeout = 50
Cn.ConnectionTimeout = 50
回答by joell
After weeks of testing various code changes, we found that when changing the SQL call to QueryTablemethod instead of CopyFromRecordsetmethod, it is working fine.
经过数周的测试各种代码更改后，我们发现将 SQL 调用更改为QueryTable方法而不是CopyFromRecordset方法时，它工作正常。
So I am pasting the code if anyone needs it in future.
因此，如果将来有人需要它，我将粘贴代码。
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
