Hi group,

I've got an Access DB from which I have link tables to SQL Server. I have created a login form, from which I want the user to provide UID and PW. When the user clicks on Login I need to ensure that the login is valid and set a connection string somewhere to link the CurrentDB through to the SQL Server without the default login popup appearing. Does anyone have any code snippet that does this kind of thing. Would be most grateful. Thanks,

Mark

Mark Roworth

Hi Mark,

This function connects to an sqlserver and authenticates the user using a pre-stored connection string.


eg . ODBC;DSN=xxxxxxxx;DATABASE=xxxxxxxxxxxx;UID=XXX;PW D=xxx

Function cswCheckLink() As Integer
    On Error GoTo Error_cswCheckLink
        Dim wk As dao.Workspace
        Dim dbs As dao.Database
        Dim dbs2 As dao.Database
        Dim rstCust As dao.Recordset
        Dim rsSys As dao.Recordset
        Dim lngError As Long
        Dim SQLServer As Object
        Dim rsODBC As dao.Recordset
        Dim ret As Long

        Set dbs = CodeDb
        Set rsSys = dbs.OpenRecordset("select [connect] from MsysObjects where [name] = 'tblARCustomer'", dbOpenSnapshot)

        If left(rsSys!Connect, 3) = "DSN" Then
                ' create an instance of SQL Server
                Set SQLServer = CreateObject("SQLDMO.SQLServer")
                If Err.Number = 429 Then 'cant create object no SQLServer or MSDE installed
                        DoCmd.Close acForm, "frmSMMessage", acSaveNo
                        GoTo Exit_cswCheckLink
                End If
                ' must be running ODBC
                DoCmd.OpenForm "frmSMMessage"
                Forms!frmsmMessage!lblMessage.Caption = "Checking SQL Server Status"
                Forms!frmsmMessage.Repaint
                Set rsODBC = dbs.OpenRecordset("USysSMODBCDataSource", dbOpenSnapshot)
                If rsODBC.EOF And rsODBC.BOF Then
                        rsODBC.Close
                        Set rsODBC = Nothing
                        DoCmd.Close acForm, "frmSMMessage", acSaveNo
                        GoTo Exit_cswCheckLink
                Else
                       With rsODBC
                                If .fields("ysnTrusted") Then
                                        ' assume trusted connection
                                        ret = SQLServer.PingSQLServerVersion(CStr(Nz(.fields("st rServer"), "")))
                                Else
                                        ret = SQLServer.PingSQLServerVersion(CStr(.fields("strSe rver")), CStr(.fields("strUserID")), CStr(Nz(.fields("strPassword"), "")))
                                End If
                                If ret > 0 And ret < 256 Then
                                        Set wk = dao.Workspaces(0)
                                        If GetSetting("App", "Main", "ConnectionString", "") <> "" Then
                                                Set dbs2 = wk.OpenDatabase(CStr(rsODBC.fields("strDSN")), dbDriverNoPrompt, False, GetSetting("Image Pro 7", "Global", "ConnectionString", ""))
                                                Set rstCust = dbs2.OpenRecordset("tblARCustomer", dbOpenDynaset, dbSeeChanges)
                                                If lngError = 0 Then
                                                         cswCheckLink = True
                                                 Else ' Tables are Linked, return True
                                                         cswCheckLink = False
                                                 End If
                                                 dbs2.Close
                                        Else
                                                MsgBox "Cannot connect to SQLServer - " & vbNewLine & Err.Description & vbNewLine & "Please confirm that your SQL server is running and online", vbCritical, "App"
                                                cswCheckLink = False
                                        End If
                                End If
                        End With
                        rsODBC.Close
                        Set rsODBC = Nothing
                End If
                DoCmd.Close acForm, "frmSMMessage", acSaveNo
        End If

Exit_cswCheckLink:
        ' Close Recordsets and destroy object variables.
        rsSys.Close
        rstCust.Close
        Set wk = Nothing
        Set dbs = Nothing
        Set SQLServer = Nothing
        Set rstCust = Nothing
        Set rsSys = Nothing
        Set dbs = Nothing
        Exit Function
Error_cswCheckLink:
        lngError = Err.Number
        If Err.Number < -2140000000 Then
                MsgBox "Cannot connect to SQL server " & vbNewLine & "Error is " & Err.Number & vbNewLine & Err.Description
                GoTo Exit_cswCheckLink
        End If
        If Err.Number = 429 Then
                MsgBox "For App to run on a SQL Server database your PC must have the MSDE installed." & vbNewLine & "Please install the MSDE from the CD or from the " & vbNewLine & _
                "Microsoft Office CD", vbCritical, "App"
                GoTo Exit_cswCheckLink
        End If
        Resume Next
End Function

hopes it helps,

Rich

Hi Rich

That's a very thorough function, is there an equivalent using ADO ?

First, try to implement windows authenticated security. It is more secure and you will not have this issues.

In the meantime, you can wait until the user uses a linked table from the database to be prompted for the username and password, and if youy use ADO you can have them use another connection that youu declare via ADO. Do a search on this forum on connection and you should find the syntax. Just make sure that you set the connection for ado on a module so that you can keeo using it. Do not use currentproject.connection, as this will use your linked tables ant this defeats the purpose of using ADO.

Mark is using SQL-DMO, this can be a royal pain to deploy depending on your network configuration, MDAC, client machine, etc.

Actually, thi is the way you connect using windows authenticated security.

    With mConnection
        .Provider = "MSDataShape"
        .Properties("Data Provider") = "SQLOLEDB.1"
        .Properties("Initial Catalog") = "Northwind"
        .Properties("Persist Security Info") = False
        .Properties("Data Source") = "//servername"
        .Properties("Integrated Security") = "SSPI"
        .Open
    End With



Sal

What do I have to do to make my Windows application/SQL stored procedures use a userID and password from the registry?