VBA新数据库连接

如何更改下面的代码以防止在屏幕截图中看到的内容。

我用下面的代码运行一个macros

Dim conn As ADODB.Connection Dim rec1 As ADODB.Recordset Dim thisSql As String Set conn = New ADODB.Connection Dim sConn As String sConn = "Provider=SQLOLEDB;Trusted_Connection=Yes;Server=xyz;Database=xyz;UID=xyz;PWD=xyz" conn.Open sConn ' this is creating multiple connections. Set rec1 = New ADODB.Recordset rec1.Open thisSql, conn 

它运行SQL Server查询（大约20行，包含4个连接）。 一切都很好，除了事实上，运行几次后，我的数据库pipe理员说，我的查询加载了太多的数据库。

现在，我的查询可能会导致问题，也可能是Excel正在开始一次运行多个连接。 这方面的一些证据是下面的截图以及数据库上的负载似乎随时间增加的事实。

如何build立数据库连接而不需要不断build立新的连接？

有没有人有与Excel数据库macros相似的问题？

---

UPDATE

虽然下面的答案是非常有用的（尤其是对于从VBA开始的人），似乎我的查询负载的主要原因是多个连接的组合，并忽略了我的代码中的一行：

  With Sheets("FVols").QueryTables.Add(Connection:=rec1, Destination:=Sheets("FVols").Range("A1")) .name = "data" .FieldNames = True .Refresh BackgroundQuery:=True <<<<<<<<<<<<<<<<<<<<<<<----- End With 

Answer 1

你只需要打开连接一次。 这实际上意味着您可以在该活动连接上执行多个查询。 您必须closures连接并释放引用（ 特别是ADODB ）以避免碰到碰撞和其他连接相关的问题。

如果您知道要执行的查询，则可以创build一个数组（ 或集合 ），并将查询添加到队列中。

虽然你已经有了一个开放的连接，你可以继续执行查询。

通过代码扫描，你和我之间没有太大的区别，所以你应该能够看到发生了什么，在哪里。 如果有什么不清楚的地方，请在评论中提问

  Sub DbConnection() Dim cn As ADODB.Connection Set cn = New ADODB.Connection Dim rs As ADODB.Recordset Dim strConn As String strConn = "Driver={SQL Server};Server=; Database=; UID=; PWD=" cn.Open strConn Dim queryArr, i queryArr = Array("SELECT * FROM [MyTable]", "SELECT * FROM [MyOtherTable]") For i = LBound(queryArr) To UBound(queryArr) ExecuteQuery queryArr(i), cn, rs Next i cn.Close Set cn = Nothing End Sub Private Sub ExecuteQuery(query As Variant, ByRef cn As ADODB.Connection, ByRef rs As ADODB.Recordset) Set rs = New ADODB.Recordset With rs .ActiveConnection = cn .Open CStr(query) Sheets(1).Range("A1").CopyFromRecordset rs .Close End With Set rs = Nothing End Sub 

现在，只需要执行一次DBConnection()就可以执行数组中列出的所有查询。

或者，如果您的查询是在运行时创build的，则可以将其作为parameter passing给DbConnection() 。

 Sub DbConnection(queryQueue As Collection) Dim cn As ADODB.Connection Set cn = New ADODB.Connection Dim rs As ADODB.Recordset Dim strConn As String strConn = "Driver={SQL Server};Server=HELIUM\PRI; Database=sourcedata; UID=tabula; PWD=Tabula123!" cn.Open strConn For i = 1 To queryQueue.Count ExecuteQuery queryQueue.Item(i), cn, rs Next i cn.Close Set cn = Nothing End Sub Private Sub ExecuteQuery(query As Variant, ByRef cn As ADODB.Connection, ByRef rs As ADODB.Recordset) Set rs = New ADODB.Recordset With rs .ActiveConnection = cn .Open CStr(query) Sheets(1).Range("A1").CopyFromRecordset rs .Close End With Set rs = Nothing End Sub 

更新：

您可以将您的连接声明为全局variables 。 现在，您可以随意运行DBConnection()多次，而且每次都不会创build新的连接。 相反，您将使用全局连接对象。

 Option Explicit Public cn As ADODB.Connection Sub DbConnection() Set cn = New ADODB.Connection Dim rs As ADODB.Recordset Dim strConn As String strConn = "Driver={SQL Server};Server=; Database=; UID=; PWD=" cn.Open strConn Set rs = New ADODB.Recordset With rs .ActiveConnection = cn .Open "SELECT * FROM [MyTable]" Sheets(1).Range("A1").CopyFromRecordset rs .Close End With Set rs = Nothing cn.Close Set cn = Nothing End Sub 

Answer 2

当你完成它时，你是否释放连接variables？ 即

 Set rec1 = Nothing 

如果没有，连接将不会完全closures。