Remote Desktop Connection VB?

[Desu Nota from Columbus]

The below macro, until a recent network change/update worked like a charm.

It attaches to a database on a virtual server and based on the query returns the data (which is then analyzed and manipulated by the rest of the macro (not shown)).

I can no longer directly link to the server GGVORNE, instead I have to Remote Desktop link to the server SIDWTS first.

Once connected to SIDWTS, I can then Remote Desktop link to GGVORNE.

Basically, I need to know how to add this second step into the below macro. Is this possible?

Is there a way to edit the database connection path to run through SIDWTS first? (User_ID and Password is not static. Whomever is running this macro will need to enter their USER_ID and Password to log onto SIDWTS)

Thanks for the help!

Sub ATest()
Dim i As Integer
Dim lRow As Long
Dim iRow As Long
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim startDate As Date
Dim endDate As Date

Server_Name = "GGVORNE\SQLEXPRESS" ' Enter your server name here
Database_Name = "VorneDB" ' Enter your database name here
User_ID = "vorne" ' enter your user ID here
Password = "@@@@@@" ' Enter your password here
startDate = Range("A1").Value
endDate = Range("A2").Value
SQLStr = ""
SQLStr = SQLStr & " SELECT * FROM [VorneDB].[dbo].[interval_stream] "
SQLStr = SQLStr & " WHERE [start_time] >= '" & Format(startDate, "yyyy-mm-dd hh:nn:ss.000") & "'"
SQLStr = SQLStr & " AND [end_time] <= '" & Format(endDate, "yyyy-mm-dd hh:nn:ss.000") & "'"
MsgBox SQLStr
Debug.Print SQLStr
Application.ScreenUpdating = False

Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"

rs.Open SQLStr, Cn, adOpenStatic
' Dump to spreadsheet
With Worksheets("sheet1").Range("a1:z50000") ' Enter your sheet name and range here
    .ClearContents
    .CopyFromRecordset rs
End With
'            Tidy up
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing

With Sheets("Sheet1")
    Columns("A:BB").Select
    Selection.NumberFormat = "General"
    Range("A:A,J:J,AS:AS").Select
    Selection.NumberFormat = "m/d/yyyy h:mm"
End With

 

[Desu Nota from Columbus]

bump....