Option Compare Database
Option Explicit

Public Enum appConnectionString
    appSQLServerBackend = 2
    appWebSQLServer = 3
    appIntranetSQLServer = 4
    appSQLServerDataPrep = 5
    appSQLServerFMB = 6
End Enum

Public Function GetConnectionString(lngConnection As appConnectionString) As String

    Dim strComputerName As String
    
    strComputerName = windowscomputername()
    
    Select Case lngConnection
    
        Case appSQLServerBackend
        
            GetConnectionString = "Provider=SQLOLEDB.1;Initial Catalog=DB1;Data Source = Server1;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Trusted_Connection=Yes"
            
        Case appWebSQLServer
        
            GetConnectionString = "Provider=SQLOLEDB.1;Initial Catalog=DB2;Data Source =something.com,4506;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;UID=User;PWD=Password"
         
         Case appIntranetSQLServer
        
            GetConnectionString = "Provider=SQLOLEDB.1;Initial Catalog=DB3;Data Source=Server3;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;UID=User;PWD=Password"
    
        Case appSQLServerDataPrep
        
            GetConnectionString = "Provider=SQLOLEDB.1;Initial Catalog=DB4;Data Source = " & strComputerName & "\SQLEXPRESS;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Trusted_Connection=Yes"
 
         Case appSQLServerFMB
        
            GetConnectionString = "Provider=SQLOLEDB.1;Initial Catalog=DB5;Data Source = Server5;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Trusted_Connection=Yes"

    End Select
            
End Function

'
' Class Module Cls_SQL_PassThrough
' --------------------------------

Option Compare Database
Option Explicit

Private m_dbs As DAO.Database
Private m_qdf As DAO.QueryDef
Private m_strConnection As String
Private m_strSQL As String
Private m_strQueryName As String

Private Sub Class_Initialize()

    Set m_dbs = CurrentDb
    Set m_qdf = m_dbs.CreateQueryDef

End Sub

Private Sub Class_Terminate()

    Set m_qdf = Nothing
    Set m_dbs = Nothing

End Sub

Public Property Get Connection() As String

    Connection = m_strConnection

End Property

Public Property Let Connection(ByVal ConnectionString As String)

    m_strConnection = ConnectionString

End Property

Public Function Execute(Optional ByVal ConnectionString As Variant, _
                        Optional ByVal SQLString As Variant, _
                        Optional ByVal QueryName As Variant) As Long


    On Error GoTo Err_Execute

    If Not IsMissing(ConnectionString) Then m_strConnection = ConnectionString
    If Not IsMissing(SQLString) Then m_strSQL = SQLString
    If Not IsMissing(QueryName) Then m_strQueryName = QueryName
    
    If Len(m_strConnection) > 0 And Len(m_strSQL) > 0 Then
        With m_qdf
            .Name = m_strQueryName
            .Connect = m_strConnection
            .SQL = m_strSQL
            .ReturnsRecords = (Len(m_strQueryName) > 0)
            If .ReturnsRecords = False Then
                .Execute
            Else
                If DCount("*", "MsysObjects", "Name='" & m_strQueryName & "' And Type=5") <> 0 Then m_dbs.QueryDefs.Delete m_strQueryName
                m_dbs.QueryDefs.Append m_qdf
            End If
            .Close
        End With
        Execute = True
    End If

Exit_Execute:
    On Error GoTo 0
    Exit Function

Err_Execute:
    Execute = Err.Number
    Err.Clear
    Resume Exit_Execute
    
End Function

Public Property Get QueryName() As String

    QueryName = m_strQueryName

End Property

Public Property Let QueryName(ByVal QueryName As String)

    m_strQueryName = QueryName

End Property

Public Property Get SQL() As String

    SQL = m_strSQL

End Property

Public Property Let SQL(ByVal strSQL As String)

    m_strSQL = strSQL

End Property

Sub Test_Cls_SQL_PassThrough_Query()
'
' This creates a permanent query into the current database.
'
    Dim cls As Cls_SQL_PassThrough
    
    Set cls = New Cls_SQL_PassThrough
    With cls
        .QueryName = "Qry_Procedure_Names"
        .Connection = "ODBC;DRIVER={SQL Server};SERVER=SOLIMAN;DATABASE=Scoreboard;TRUSTED_CONNECTION=Yes;"
        .SQL = "SELECT * FROM Tbl_Procedure_Names WHERE Inactive = 0;"
        .Execute
    End With
    Set cls = Nothing
    
End Sub

Sub Test_Cls_SQL_PassThrough_Command()
'
' This executes a SQL command into the remote database.
'
    Dim cls As Cls_SQL_PassThrough
    
    Set cls = New Cls_SQL_PassThrough
    With cls
        .QueryName = ""
        .Connection = "ODBC;DRIVER={SQL Server};SERVER=SOLIMAN;DATABASE=Scoreboard;TRUSTED_CONNECTION=Yes;"
        .SQL = "DELETE FROM Tbl_Procedure_Names WHERE Inactive = 1;"
        .Execute
    End With
    Set cls = Nothing
    
End Sub