VBA New Database Connection - sql

Question

How to change the code below to prevent what you see in the screenshot.
I am running a macro with the following code
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
which runs a SQL Server query (which is around 20 lines long and contains 4 joins). Everything is fine except for the fact that after a couple times of running it my DB admin says that my query is loading up the DB too much.
Now, my query could be causing the problem, or it could be that Excel is starting to run multiple connections at once. Some evidence for this is the screenshot below and the fact that the load on the database appears to increase with time.
How do I establish a DB connection without constantly creating new connections?
Has anyone had similar problems working with Excel DB macros?
UPDATE
While the answers below were very useful (especially for someone starting out in VBA), it seems that the main reason my query was taking up load was a combination of multiple connections and having overlooked a line in my code:
With Sheets("FVols").QueryTables.Add(Connection:=rec1, Destination:=Sheets("FVols").Range("A1"))
.name = "data"
.FieldNames = True
.Refresh BackgroundQuery:=True <<<<<<<<<<<<<<<<<<<<<<<-----
End With

Answer 1

You only need to open the connection once. That literally means you can execute multiple queries on that one active connection. You must close the connection and free the reference (specially with ADODB) to avoid running into collisions and other connection related problems.
If you know the queries you are going to be executing you can create an array (or collection) and add queries to the queue.
While you already have an open connection to work with you can keep executing queries.
Scan through code there is not much difference between yours and mine so you should be able to see what is going on and where. Please, ask questions in the comments if anything is unclear
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
Now, you only need to execute the DBConnection() once and all the queries you listed in the array will be executed.
Alternatively, if your queries are created at run-time you can pass it to the DbConnection() as a parameter.
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
Update:
You can declare your connection as a Global Variable. Now you can run the DBConnection() as many times as you like and you will not be creating a new connection each time. Instead you will be using the global connection object.
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

Are you releasing the connection variable when you've finished with it? i.e.
Set rec1 = Nothing
The connection won't close fully if not.