ADODB Connections are veeeery slow

I wonder if it anyone know any good tips & tricks to improve performance on ADODB Connections.
Sometimes it goes veeery slow to open the connection and running the query takes under a second and other times opening the connection goes fast but running the query takes ages.

I have noticed that its usually the first time the query is runned its taking the longest. If the same query is beeing run again it goes ALOT faster.
I have tried running a simpler query to the DB when opening the worksheet to improve the time it takes to open the connection, but it doesnt seem to help that much for some reason.

The SQL statements are also pretty huge, around 2000 characters (no spaces)
I read somewhere else that adding:
rec1.CursorLocation = adUseClient
rec1.CursorType = adOpenStatic
might help. But didn't see much difference.

Sub GetData(dato_from As String, dato_to As String, x As String)
On Error GoTo ErrorHandler
Dim conn As ADODB.Connection
Dim rec1 As ADODB.Recordset
Dim SQLquery As String

Set conn = New ADODB.Connection

If (x = "input_a") Then   
    conn.Open "DSN=<server1>;UID=<userID>;SRVR=<server1>;DB=<DB>;PWD=<PWD>"
    SQLquery = "Huge SQL query"
ElseIf (x = "input_a_b") Then
    conn.Open "DSN=<server2>;UID=<userID>;SRVR=<server2>;DB=<DB>;PWD=<PWD>"
    SQLquery = "Huge SQL query"
ElseIf (x = "input_c") Then   
    conn.Open "DSN=<server2>;UID=<userID>;SRVR=<server2>;DB=<DB>;PWD=<PWD>"
    SQLquery = "Huge SQL query"
ElseIf (x = "input_e") Then
    conn.Open "DSN=<server2>;UID=<userID>;SRVR=<server2>;DB=<DB>;PWD=<PWD>"
    SQLquery = "Huge SQL query"
End If
    Set rec1 = New ADODB.Recordset
    rec1.CursorLocation = adUseClient
    rec1.CursorType = adOpenStatic
    rec1.Open SQLquery, conn
    count = rec1.RecordCount
    
If (count > 0) Then
    Sheet1.Shapes("TextBox 9").Line.ForeColor.ObjectThemeColor = msoThemeColorAccent3
    Sheet1.Shapes("TextBox 9").Line.ForeColor.Brightness = 0
    Sheet1.Shapes("TextBox 26").Line.ForeColor.ObjectThemeColor = msoThemeColorAccent3
    Sheet1.Shapes("TextBox 26").Line.ForeColor.Brightness = 0
    Sheet1.Shapes("TextBox 38").Line.ForeColor.ObjectThemeColor = msoThemeColorAccent3
    Sheet1.Shapes("TextBox 38").Line.ForeColor.Brightness = 0

    If (count = 1) Then
        Sheet1.Shapes("TextBox 26").TextFrame.Characters.Text = "Found" & count & " row"
    Else
        Sheet1.Shapes("TextBox 26").TextFrame.Characters.Text = "Found" & count & " rows"
    End If

    With Sheet1.QueryTables.Add(Connection:=rec1, Destination:=Sheet1.Range("A13"))
        .Name = "data"
        .FieldNames = True
        .Refresh BackgroundQuery:=False
    End With
Else
    Sheet1.Shapes("TextBox 9").Line.ForeColor.RGB = RGB(192, 0, 0)
    Sheet1.Shapes("TextBox 26").Line.ForeColor.RGB = RGB(192, 0, 0)
    Sheet1.Shapes("TextBox 38").Line.ForeColor.RGB = RGB(192, 0, 0)
    Sheet1.Shapes("TextBox 26").TextFrame.Characters.Text = "No data found"
    Exit Sub
End If

ErrorExit:
    Set conn = Nothing
    Set rec1 = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, vbCritical
   Resume ErrorExit
   cnt.Close
    If CBool(cnt.State And adStateOpen) Then
    Set conn = Nothing
    Set rec1 = Nothing
    End If
End Sub

As you can see from the code its 2 different servers that the querys can go to. So one question is that if I run a query on Server 1 does the connection to server 2 get terminated?
Is there a way to keep both connections open?

Here are the methods I run when the sheet is opened. Theese query goes very fast to open connection and run. So question again is if this actually should help? Are the connections beeing kept alive?

Sub UpdateDB()
On Error GoTo ErrorHandler
Dim conn As ADODB.Connection
Dim rec1 As ADODB.Recordset
Dim thisSql As String

Set conn = New ADODB.Connection
conn.Open "DSN=<server2>;UID=<userID>;SRVR=<server2>;DB=<DB>;PWD=<Password>"
thisSql = "select top 1 ...."

Set rec1 = New ADODB.Recordset
rec1.Open thisSql, conn

With Sheet1.QueryTables.Add(Connection:=rec1, Destination:=Sheet1.Range("A1"))
    .Name = "data"
    .FieldNames = True
    .Refresh BackgroundQuery:=False
End With
Range("A2").HorizontalAlignment = xlCenter
ErrorExit:
    Set conn = Nothing
    Set rec1 = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, vbCritical
    Resume ErrorExit
    cnt.Close
    If CBool(cnt.State And adStateOpen) Then
        Set conn = Nothing
        Set rec1 = Nothing
    End If
End Sub

Sub UpdateDBA()
On Error GoTo ErrorHandler
Dim conn As ADODB.Connection
Dim rec1 As ADODB.Recordset
Dim thisSql As String

Set conn = New ADODB.Connection
conn.Open "DSN=<server1>;UID=<userID>;SRVR=<server1>;DB=<DB>;PWD=<Password>"
thisSql = "select top 1..."

Set rec1 = New ADODB.Recordset
rec1.Open thisSql, conn

ErrorExit:
    Set conn = Nothing
    Set rec1 = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, vbCritical
    Resume ErrorExit
    cnt.Close
    If CBool(cnt.State And adStateOpen) Then
        Set conn = Nothing
        Set rec1 = Nothing
    End If
End Sub