MyTetra Share
Делитесь знаниями!
Использование соединений без DSN
Время создания: 31.03.2020 14:47
Текстовые метки: Access, DSN
Раздел: !Закладки - MSO - Access - Работа в сети с базой Access
Запись: xintrea/mytetra_db_adgaver_new/master/base/15856552430ci2n7dx3l/text.html на raw.githubusercontent.com

Using DSN-Less Connections

Typically, linking an Access front-end to tables in some other DBMS involves using a Data Source Name (DSN), usually created through the ODBC Data Source Administrator windo, which is accessible from the Windows Control Panel (or Administrator Tools in Windows 2000). However, this requires that a DSN be created for each workstation that's going to use the front-end application.

While it is possible to programmatically create the DSN (see, for example, HOWTO: Programmatically Create a DSN for SQL Server with VB (Q184608)), I find it's more flexible to use a DSN-less connection.

The code that follows shows one way to convert existing linked tables to use a DSN-less connection. In the example, I'm creating a DSN-less link for SQL Server, using Trusted Connection. If you're going against a different DBMS, or want different options connecting to SQL Server, check out the various ODBC DSN-Less connection strings that Carl Prothman lists at Connection Strings, or check The Connection String Reference at ConnectionStrings.com. The important thing to remember is that you must use an ODBC connection string (Access will not allow you to use OleDB), and you must ensure the connection string starts with ODBC;. For instance, ConnectionStrings.com says that the MySQL Connector/ODBC 3.51 string is

Driver={MySQL ODBC 3.51 Driver};Server=localhost;Database=myDataBase; User=myUsername;Password=myPassword;Option=3;

 

That means you must set strConnectionString in the code below to something like:

 

  strConnectionString = "ODBC;Driver={MySQL ODBC 3.51 Driver};" & _

    "Server=localhost;Database=" & DataBaseName & ";" & _

    "User=" & UID & ";" & _

    "Password=" & PWD & ";" & _

    "Option=3;"

 

My advice is to create your linked tables using a DSN, and then convert them this way before you deploy the application. When you create the linked tables, you may be asked to indicate the Unique Identifiers for the linked table. This happens when the object to which you're linking does not have its own unique identifier (unique index) that Access can utilize. If you do not specify the unique identifiers, you will not be able to perform updates on the linked table.

The code below needs to be run any time you want to change the server and/or database to which the tables are linked. However, if your server and/or database hasn't changed, you shouldn't need to rerun the code. In other words, you should be able to do this just prior to deploying to your users, and everything will run properly.

If you've added this code in a module, you can invoke it from the Debug Window (Ctrl-G) by typing:

FixConnections "MyServer", "MyDatabase"

and hitting Enter (where, of course, you replace MyServer and MyDatabase by whatever's appropriate).

Note that I'm using DAO (Data Access Objects) to make this work. Access 2000 or 2002 use ADO (ActiveX Data Objects) by default: you'll have to add a reference to DAO in order to be able to use this code. To do this, open any code module, then select Tools | References from the menu bar. Scroll through the list of available references until you find the one for Microsoft DAO 3.6 Object Library, and select it.

Note also that this is a revised version of the code. There was a problem with the previous version handling certain cases of indexes in the linked table. I've tested this as thoroughly as I can (given I wasn't having those problems), and I think it'll work now. However, I've put some specific error checking when there's a problem with the indexes. If you're posting a problem to the newsgroup, please indicate exactly what's shown in that error message.

And I should point out that you should use this code on a copy of your database. If you run into a problem, throw away that copy of the database and make a new one before you try running the code again. It's entirely possible that there might be problems if the code has run partway through, but not completed successfully.


'***************** Code Start **************

 

Type TableDetails

    TableName As String

    SourceTableName As String

    Attributes As Long

    IndexSQL As String

    Description As Variant

End Type

 

Sub FixConnections( _

    ServerName As String, _

    DatabaseName As String, _

    Optional UID As String, _

    Optional PWD As String _

)

' This code was originally written by

' Doug Steele, MVP  AccessMVPHelp@gmail.com

' Modifications suggested by

' George Hepworth, MVP   ghepworth@gpcdata.com

'

' You are free to use it in any application

' provided the copyright notice is left unchanged.

'

' Description:  This subroutine looks for any TableDef objects in the

'               database which have a connection string, and changes the

'               Connect property of those TableDef objects to use a

'               DSN-less connection.

'               It then looks for any QueryDef objects in the database

'               which have a connection string, and changes the Connect

'               property of those pass-through queries to use the same

'               DSN-less connection.

'               This specific routine connects to the specified SQL Server

'               database on a specified server.

'               If a user ID and password are provided, it assumes

'               SQL Server Security is being used.

'               If no user ID and password are provided, it assumes

'               trusted connection (Windows Security).

'

' Inputs:   ServerName:     Name of the SQL Server server (string)

'           DatabaseName:   Name of the database on that server (string)

'           UID:            User ID if using SQL Server Security (string)

'           PWD:            Password if using SQL Server Security (string)

'

 

On Error GoTo Err_FixConnections

 

Dim dbCurrent As DAO.Database

Dim prpCurrent As DAO.Property

Dim tdfCurrent As DAO.TableDef

Dim qdfCurrent As DAO.QueryDef

Dim intLoop As Integer

Dim intToChange As Integer

Dim strConnectionString As String

Dim strDescription As String

Dim strQdfConnect As String

Dim typNewTables() As TableDetails

 

' Start by checking whether using Trusted Connection or SQL Server Security

 

  If (Len(UID) > 0 And Len(PWD) = 0) Or (Len(UID) = 0 And Len(PWD) > 0) Then

    MsgBox "Must supply both User ID and Password to use SQL Server Security.", _

      vbCritical + vbOkOnly, "Security Information Incorrect."

    Exit Sub

  Else

    If Len(UID) > 0 And Len(PWD) > 0 Then

 

' Use SQL Server Security

 

      strConnectionString = "ODBC;DRIVER={sql server};" & _

        "DATABASE=" & DatabaseName & ";" & _

        "SERVER=" & ServerName & ";" & _

        "UID=" & UID & ";" & _

        "PWD=" & PWD & ";"

    Else

 

' Use Trusted Connection

 

      strConnectionString = "ODBC;DRIVER={sql server};" & _

        "DATABASE=" & DatabaseName & ";" & _

        "SERVER=" & ServerName & ";" & _

        "Trusted_Connection=YES;"

    End If

  End If

 

  intToChange = 0

 

  Set dbCurrent = DBEngine.Workspaces(0).Databases(0)

 

' Build a list of all of the connected TableDefs and

' the tables to which they're connected.

 

  For Each tdfCurrent In dbCurrent.TableDefs

    If Len(tdfCurrent.Connect) > 0 Then

      If UCase$(Left$(tdfCurrent.Connect, 5)) = "ODBC;" Then

        ReDim Preserve typNewTables(0 To intToChange)

        typNewTables(intToChange).Attributes = tdfCurrent.Attributes

        typNewTables(intToChange).TableName = tdfCurrent.Name

        typNewTables(intToChange).SourceTableName = tdfCurrent.SourceTableName

        typNewTables(intToChange).IndexSQL = GenerateIndexSQL(tdfCurrent.Name)

        typNewTables(intToChange).Description = Null

        typNewTables(intToChange).Description = tdfCurrent.Properties("Description")

        intToChange = intToChange + 1

      End If

    End If

  Next

 

' Loop through all of the linked tables we found

 

  For intLoop = 0 To (intToChange - 1)

 

' Delete the existing TableDef object

 

    dbCurrent.TableDefs.Delete typNewTables(intLoop).TableName

 

' Create a new TableDef object, using the DSN-less connection

 

    Set tdfCurrent = dbCurrent.CreateTableDef(typNewTables(intLoop).TableName)

    tdfCurrent.Connect = strConnectionString

 

' Unfortunately, I'm current unable to test this code,

' but I've been told trying this line of code is failing for most people...

' If it doesn't work for you, just leave it out.

    tdfCurrent.Attributes = typNewTables(intLoop).Attributes

 

    tdfCurrent.SourceTableName = typNewTables(intLoop).SourceTableName

    dbCurrent.TableDefs.Append tdfCurrent

 

' Where it existed, add the Description property to the new table.

 

    If IsNull(typNewTables(intLoop).Description) = False Then

      strDescription = CStr(typNewTables(intLoop).Description)

      Set prpCurrent = tdfCurrent.CreateProperty("Description", dbText, strDescription)

      tdfCurrent.Properties.Append prpCurrent

    End If

 

' Where it existed, create the __UniqueIndex index on the new table.

 

    If Len(typNewTables(intLoop).IndexSQL) > 0 Then

      dbCurrent.Execute typNewTables(intLoop).IndexSQL, dbFailOnError

    End If

  Next

 

' Loop through all the QueryDef objects looked for pass-through queries to change.

' Note that, unlike TableDef objects, you do not have to delete and re-add the

' QueryDef objects: it's sufficient simply to change the Connect property.

' The reason for the changes to the error trapping are because of the scenario

' described in Addendum 6 below.

 

  For Each qdfCurrent In dbCurrent.QueryDefs

    On Error Resume Next

    strQdfConnect = qdfCurrent.Connect

    On Error GoTo Err_FixConnections

    If Len(strQdfConnect) > 0 Then

      If UCase$(Left$(qdfCurrent.Connect, 5)) = "ODBC;" Then

        qdfCurrent.Connect = strConnectionString

      End If

    End If

    strQdfConnect = vbNullString

  Next qdfCurrent

 

End_FixConnections:

  Set tdfCurrent = Nothing

  Set dbCurrent = Nothing

  Exit Sub

 

Err_FixConnections:

' Specific error trapping added for Error 3291

' (Syntax error in CREATE INDEX statement.), since that's what many

' people were encountering with the old code.

' Also added error trapping for Error 3270 (Property Not Found.)

' to handle tables which don't have a description.

 

  Select Case Err.Number

    Case 3270

      Resume Next

    Case 3291

      MsgBox "Problem creating the Index using" & vbCrLf & _

        typNewTables(intLoop).IndexSQL, _

        vbOKOnly + vbCritical, "Fix Connections"

      Resume End_FixConnections

    Case 18456

      MsgBox "Wrong User ID or Password.", _

        vbOKOnly + vbCritical, "Fix Connections"

      Resume End_FixConnections

    Case Else

      MsgBox Err.Description & " (" & Err.Number & ") encountered", _

        vbOKOnly + vbCritical, "Fix Connections"

      Resume End_FixConnections

  End Select

 

End Sub

 

Function GenerateIndexSQL(TableName As String) As String

' This code was originally written by

' Doug Steele, MVP  AccessMVPHelp@gmail.com

' Modifications suggested by

' George Hepworth, MVP   ghepworth@gpcdata.com

'

' You are free to use it in any application,

' provided the copyright notice is left unchanged.

'

' Description: Linked Tables should have an index __uniqueindex.

'              This function looks for that index in a given

'              table and creates an SQL statement which can

'              recreate that index.

'              (There appears to be no other way to do this!)

'              If no such index exists, the function returns an

'              empty string ("").

'

' Inputs:   TableDefObject: Reference to a Table (TableDef object)

'

' Returns:  An SQL string (or an empty string)

'

 

On Error GoTo Err_GenerateIndexSQL

 

Dim dbCurr As DAO.Database

Dim idxCurr As DAO.Index

Dim fldCurr As DAO.Field

Dim strSQL As String

Dim tdfCurr As DAO.TableDef

 

  Set dbCurr = CurrentDb()

  Set tdfCurr = dbCurr.TableDefs(TableName)

 

  If tdfCurr.Indexes.Count > 0 Then

 

' Ensure that there's actually an index named

' "__UnigueIndex" in the table

 

    On Error Resume Next

    Set idxCurr = tdfCurr.Indexes("__uniqueindex")

    If Err.Number = 0 Then

      On Error GoTo Err_GenerateIndexSQL

 

' Loop through all of the fields in the index,

' adding them to the SQL statement

 

      If idxCurr.Fields.Count > 0 Then

        strSQL = "CREATE INDEX __UniqueIndex ON [" & TableName & "] ("

        For Each fldCurr In idxCurr.Fields

          strSQL = strSQL & "[" & fldCurr.Name & "], "

        Next

 

' Remove the trailing comma and space

 

        strSQL = Left$(strSQL, Len(strSQL) - 2) & ")"

      End If

    End If

  End If

 

End_GenerateIndexSQL:

  Set fldCurr = Nothing

  Set tdfCurr = Nothing

  Set dbCurr = Nothing

  GenerateIndexSQL = strSQL

  Exit Function

 

Err_GenerateIndexSQL:

' Error number 3265 is "Not found in this collection

' (in other words, either the tablename is invalid, or

' it doesn't have an index named __uniqueindex)

  If Err.Number <> 3265 Then

    MsgBox Err.Description & " (" & Err.Number & ") encountered", _

      vbOKOnly + vbCritical, "Generate Index SQL"

  End If

  Resume End_GenerateIndexSQL

 

End Function

 


'************** Code End *****************

Addendum 1: I received e-mail about this from Bryan Beissel. Bryan indicated that he didn't want to use Trusted Connection. However, Access wouldn't save the information. Bryan came across an article that indicated that you needed to set tdfCurrent.Attributes to DB_ATTACHSAVEPWD in order to have Access save the user id and password information for each table.

That implies changing the line of code

tdfCurrent.Attributes = typNewTables(intLoop).Attributes

to

tdfCurrent.Attributes = typNewTables(intLoop).Attributes Or DB_ATTACHSAVEPWD

I haven't tried this myself (as I always use trusted connection). On first glance, it would seem to be a questionable idea, as you'd end up store the User ID and password in plain text in the Connect property. However, if that doesn't bother you, go for it!

Addendum 2: Bill Murphy pointed out in microsoft.public.access.modulesdaovba that my code wasn't propagating the Description property if one existed. D'oh!

The code above has been modified to allow for this. Note that the Description property doesn't actually exist unless a description has been added. That means that if you refer to the Description property and one doesn't exist, you'll end up with an Error (3270: Property not found.). To get around this, I'm trapping for error 3270 in my error handling in the routine FixConnections. I'm storing the Description in a Variant field, so that I can actually save a Null if no description exists. Note that I have to add the newly created TableDef object to the TableDefs collection before I can add the description. (I certainly didn't expect that!)

Addendum 3: Someone (I'm afraid I've forgotten whom) had a scenario where some of the tables were linked to another Jet database, and others were linked using ODBC to SQL Server. The code above makes the simplifying assumption that all tables are linked to the same backend. If you only need to relink some of the tables, you'll have to come up with your own approach to determining which tables need to be relinked.

For instance, if all of your ODBC-linked tables need to be changed, you can rewrite the section of code that populates typNewTables, such as:

' Build a list of all of the connected TableDefs and

' the tables to which they're connected.

  For Each tdfCurrent In dbCurrent.TableDefs

    If Len(tdfCurrent.Connect) > 0 Then

      If Left$(tdfCurrent.Connect, 5) = "ODBC;" Then

        ReDim Preserve typNewTables(0 To intToChange)

        typNewTables(intToChange).Attributes = tdfCurrent.Attributes

        typNewTables(intToChange).TableName = tdfCurrent.Name

        typNewTables(intToChange).SourceTableName = tdfCurrent.SourceTableName

        typNewTables(intToChange).IndexSQL = GenerateIndexSQL(tdfCurrent.Name)

        typNewTables(intToChange).Description = Null

        typNewTables(intToChange).Description = tdfCurrent.Properties("Description")

        intToChange = intToChange + 1

      End If

    End If

  Next

 

Addendum 4: While this doesn't directly affect what's discussed on this page, if you're using Vista, rather than use

tdfCurrent.Connect = "ODBC;DRIVER={sql server};DATABASE=" & _

DatabaseName & ";SERVER=" & ServerName & _

";Trusted_Connection=Yes;"

you should use

tdfCurrent.Connect = "ODBC;DRIVER={SQL Native Client};DATABASE=" & _

DatabaseName & ";SERVER=" & ServerName & _

";Trusted_Connection=Yes;"


See the Vista, ODBC and SQL Server 2005 thread at Google Groups.

Addendum 5: George Hepworth pointed out to me that if the connection string you provide is incorrect (eg. the Server is mistyped, or the database doesn't exist), you're going to end up deleting all your linked tables. For this reason, you might consider storing the details of the linked tables in a local table (or in the registry or in an INI file).

Addendum 6: Ben Clothier discovered that if there's a bad query in the database (for instance, an ambiguous join and the query was saved without correcting the error), the code will fail even if the bad query is not a pass-through query. He graciously provided the updated code for sub FixConnections.

Addendum 7: I finally got around to correcting an error in Addendum 1! I originally had

tdfCurrent.Attributes = typNewTables(intLoop).Attributes And DB_ATTACHSAVEPWD

and it should be

tdfCurrent.Attributes = typNewTables(intLoop).Attributes Or DB_ATTACHSAVEPWD


Access Home

 
MyTetra Share v.0.59
Яндекс индекс цитирования