用于打开链接表访问-> SQL Server（VBA）的连接字符串

Question

I've been looking for the answer as there are many similar questions, but haven´t found this particular case.

I have an SQL server, and an Access File (front-end). This Access file has linked tables, linked with the SQL server, and every time I try to open one table, a prompt appears asking for user and password.

OK, this is perfect, as it is (almost) the behaviour I want.

Also, there's a local table, that contains User/Pass with passwords encrypted. Every time the user opens the file, his/her pass is decrypted and I would like to open a connection, so linked tables won´t ask for pass.

Does anybody know how to code this connection?

Thanks in advance!

Answer 1

I think what you want is a "DSN-LESS connection" . I've done something similar in the past. Basically, at user login you re-link the tables using a connection string that you build based on the user's credentials.

Take a look at this prior SO Question for more details.

Also, here are a few routines I've used in the past that you are free to use \\ modify. Call these from your login process.

Public Function RelinkDSNTables( _
      ByVal ServerName As String, _
      ByVal DatabaseName As String, _
      ByVal UserName As String, _
      ByVal Password As String) As Boolean
On Error GoTo Err_Handler

Dim dsn As String
dsn = GetDSNLink(ServerName, DatabaseName, UserName, Password)
Dim td As TableDef
Dim db As DAO.Database
Set db = CurrentDb
Dim rst As ADODB.Recordset

'Get a list of tables that need to be relinked'
If GetLocalRecordSet(rst, "SELECT * FROM TableMapping") < 1 Then
   Err.Raise 1000, "Missing Tables!", "Missing Table Mappings!"
End If

Dim fNeedToRefresh As Boolean

'See if we actually need to relink the tables'
For Each td In db.TableDefs
   If td.Connect <> vbNullString Then
      If td.Connect <> dsn Then
         fNeedToRefresh = True
         Exit For
      End If
   End If
Next td

If fNeedToRefresh = False Then
   RelinkDSNTables = True
   GoTo Err_Handler
End If

'Drop linked table in Access'
For Each td In CurrentDb.TableDefs
   If td.Connect <> vbNullString Then
      CurrentDb.TableDefs.Delete td.Name
   End If
Next td

'Create new linked table using new DSN'
rst.MoveFirst
Do Until rst.EOF
   Set td = db.CreateTableDef(rst!LocalTableName, dbAttachSavePWD, rst!RemoteTableName, dsn)
   db.TableDefs.Append td
   rst.MoveNext
Loop

'Because I am paranoid, refresh the link'
db.TableDefs.Refresh
For Each td In db.TableDefs
   If td.Connect <> "" Then td.RefreshLink
Next td

RelinkDSNTables = True

Err_Handler:
   If Err.Number = 3011 Then
      'Happens if user does not have permission in SQL Server; Nothing to see here, move along'
      Err.Clear
      Resume Next
   ElseIf Err.Number = 3010 Then
      'already exists; should not occur, but if it does eat the exception and move on'
      Err.Clear
      Resume Next
   ElseIf Err.Number <> 0 Then
      Err.Raise Err.Number, Err.Source, Err.Description
   End If
End Function

Private Function GetDSNLink( _
      ByVal ServerName As String, _
      ByVal DatabaseName As String, _
      ByVal UserName As String, _
      ByVal Password As String) As String
On Error GoTo Err_Handler

If ServerName = "" Or DatabaseName = "" Then
   Err.Raise -1220, "Missing Server \ DB", _
      "Unable to refresh table links because you are missing the server or database name!"
End If

Dim dsnLink As String

If UserName = "" Then
   'trusted connection'
   dsnLink = "ODBC;DRIVER=SQL Server;SERVER=" & ServerName & _
            ";DATABASE=" & DatabaseName & ";Trusted_Connection=Yes"
Else
   'MixedMode connection'
     '//WARNING: This will save the username and the password with the linked table information.
   dsnLink = "ODBC;DRIVER=SQL Server;SERVER=" & ServerName & _
            ";DATABASE=" & DatabaseName & ";UID=" & UserName & ";PWD=" & Password
End If

GetDSNLink = dsnLink

Err_Handler:
   If Err.Number <> 0 Then
      Err.Raise Err.Number, Err.Source, Err.Description
   End If
End Function

Edit: Added sample GetLocalRecordSet Function

Public Function GetLocalRecordSet(ByRef rs As ADODB.Recordset, ByVal sql As String) As Long
On Error GoTo Err_Handler

If sql = vbNullString Then
   Err.Raise vbObjectError + 1001, _
      "Empty SQL String", "Empty SQL String Passed to GetLocalRecordset Function!"
End If

Set rs = New ADODB.Recordset

rs.Open sql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

If rs Is Nothing Then
   GetLocalRecordSet = -1
   GoTo Err_Handler
End If

If rs.State = adStateOpen Then
   If Not rs.EOF Then
      rs.MoveLast
      GetLocalRecordSet = rs.RecordCount                 'store number of records
      rs.MoveFirst
   Else
      GetLocalRecordSet = 0
   End If
Else
   GetLocalRecordSet = -2
End If

Err_Handler:
   If Err.Number <> 0 Then
      Err.Raise Err.Number, Err.Source, Err.Description
   End If
End Function

Answer 2

You can write a code to programmatically connect to the SQL database with username/password stored in your local table. This should happen on Access app load (eg using Autoexec macro).

You can read about Autoexec macro here: http://www.vb123.com/toolshed/05_map/ch04_autoexec.htm

So, you would have a function eg OpenConnection() which is called from Autoexec macro at application start. Any subsequent table openings should not prompt for the password.

I am not sure if this will work with the SQL back-end, though. Hopefully, it will.