'********* Connect Command Button Code **************
    Private Sub cmdConnect_Click()
    On Error Resume Next
 
        ' Validate user supplied login arguments
        ' ... validation code goes here
 
        'Create connect string from user input box values
        strConnect = "Provider=SQLOLEDB.1" _
                   & ";User ID=" & Me!txtUID _
                   & ";Password=" & Me!txtPWD _
                   & ";Initial Catalog=" & Me!txtDatabase _
                   & ";Data Source=" & Me!txtServer
 
        Screen.MousePointer = vbHourglass
 
        'Call sub to test connect string
        If TestConnectString(strConnect) = False Then
            strMsg = "Server not found or login invalid."
            MsgBox strMsg, vbExclamation, "Error"
            'Exit the routine because there was an error
        Else
            'Toggle command buttons and text boxes appropriately
            '... do stuff here
        End If
 
        Screen.MousePointer = vbNormal
 
    End Sub
 
'********* Test Connect String Sub **************
    Function TestConnectString(ByVal sConn As String) As Boolean
    On Error Resume Next
 
        Dim cnn As ADODB.Connection
        Set cnn = New ADODB.Connection
 
        'TestConnectString initializes to False by default
        cnn.Open sConn
 
        'No error means that the connect string works!
        If Err.Number = 0 Then TestConnectString = True
 
        ' Clean up and release resources
        cnn.Close
        Set cnn = Nothing
 
    End Function
 
'********* Execute Command Button Code **************
    Private Sub cmdExecute_Click()
    On Error Resume Next
 
        Dim cnn As ADODB.Connection
        Dim rst As ADODB.Recordset
        Dim fld As ADODB.Field
 
        Dim strMsg As String
        Dim strHeaders As String
        Dim strResults As String
 
        ' Simple validation that SQL statement exists
        If Len(Me!txtSQL) = 0 Then
            strMsg = "Enter a valid SQL Statement."
            MsgBox strMsg, vbExclamation, "Error"
            Exit Sub
        End If
 
        MousePointer = vbHourglass
 
        ' Instantiate Connection and Recordset objects
        Set cnn = New ADODB.Connection
        Set rst = New ADODB.Recordset
 
        ' Open Connection and Load Recordset
        cnn.Open strConnect
        rst.Open CStr(Me!txtSQL), cnn
 
        ' Create column headers
        For Each fld In rst.Fields
            strHeaders = strHeaders & UCase(fld.Name) & vbTab 
        Next
 
        ' Use the GetString method to retrieve recordset text
        strResults = rst.GetString(adClipString, -1, vbTab, vbCrLf)
 
        ' Return header and data to results pane
        Me!txtResults = strHeaders & vbCrLf & strResults
 
        ' If there was an error then replace the output
        ' text with the description of the error.
        If Err.Number > 0 Then Me!txtResults = Err.Description
 
        ' Clean up and release resources
        rst.Close
        Set rst = Nothing
        cnn.Close
        Set cnn = Nothing
 
        MousePointer = vbNormal
 
    End Sub