DNSLess connect String VBA for Access 2010 to SQL 2008 R2 (1 Viewer)

Sub RefreshDSNLess2() ' Existing table in Access 2010 was upsized to SQL Server 2008 RC2
Dim ConnectString As String
Dim strConnectionString As String
Dim scn As String
Dim sLocalName As String
Dim UID As String
Dim PWD As String
UID = "dataUser"
PWD = "dataPW"
sLocalName = "R_33"     ' <<<---pick linked table with SQL Server Security
Dim DataBaseName As String
DataBaseName = "RegulatoryDB"
' Note - updated recently updated to SQL Server Native Client 11.0  ' really nice!
strConnectionString = "ODBC;DRIVER=SQL Server Native Client 10.0;" & _
    "SERVER=DenReg-Test;DATABASE=" & DataBaseName & ";" & _
    "UID=" & UID & ";" & _
    "Password=" & PWD & ";" & _
    "Table=DBO." & sLocalName ' & ";Option=3;"  ' Don't actually know what option 3 does - think it peresists
 
    Debug.Print strConnectionString
With CurrentDb
    .TableDefs(sLocalName).Connect = strConnectionString 'scn
        ' ODBC;DRIVER=SQL Server Native Client 10.0;SERVER=DenReg-Test;DATABASE=RegulatoryDB;UID=datamig;Password=datamig;Table=DBO.R_33
    .TableDefs(sLocalName).RefreshLink ' otherwise, it won't show until the user interface selects some other object, then returns back to Tables
 
End With
End Sub

Option Compare Database
Public Function LinkAllTables(Server As Variant, Database As Variant, _
                            OverwriteIfExists As Boolean, _
                            Optional Schema As Variant)
                            If IsMissing(Schema) = True Then Schema = "dbo"
 
On Error GoTo Function_End
    'Usage Example:  Call linkalltables("SQL01","SQLDB", true, "HR")
 
    ' (link all tables in database "SQLDB" on SQL Server Instance SQO01,
    ' in the 'dbo' and 'HR' schema's overwriting any existing linked tables.
    'This will also update the link if the underlying table definition has been modified.
    Dim rsTableList As New ADODB.Recordset
    Dim sqlTableList As String
    sqlTableList = "SELECT [TABLE_SCHEMA] + '.' + [TABLE_NAME] as tableName"
    sqlTableList = sqlTableList + " FROM [INFORMATION_SCHEMA].[TABLES]"
    sqlTableList = sqlTableList + " INNER JOIN [sys].[all_objects]"
    sqlTableList = sqlTableList + " ON [INFORMATION_SCHEMA].[TABLES].TABLE_NAME = [sys].[all_objects].[name]"
    sqlTableList = sqlTableList + " WHERE [sys].[all_objects].[type]=N'U' AND [sys].[all_objects].[is_ms_shipped]<>1"
 
    rsTableList.Open sqlTableList, BuildSQLConnectionString(Server, Database)
    Dim arrSchema As Variant
    While Not rsTableList.EOF
      arrSchema = Split(rsTableList("tableName"), ".", , vbTextCompare)
 
        Select Case LCase(arrSchema(0))
            Case "common"
                If LinkTable(arrSchema(1), Server, Database, rsTableList("tableName"), OverwriteIfExists) Then
'                Debug.Print "Linking common table " & rsTableList("tableName")
                End If
            Case LCase(Schema)
                If LinkTable(arrSchema(1), Server, Database, rsTableList("tableName"), OverwriteIfExists) Then
'                Debug.Print "Linking schema table " & rsTableList("tableName")
                End If
            Case Else
                'Skip
        End Select
 
    rsTableList.MoveNext
    Wend
Function_End:
    rsTableList.Close
End Function
Function LinkTable(LinkedTableAlias As Variant, Server As Variant, Database As Variant, SourceTableName As Variant, OverwriteIfExists As Boolean)
    'This method will also update the link if the underlying table definition has been modified.
    'The overwrite parameter will cause it to re-map/refresh the link for LinktedTable Alias, but only if it was already a linked table.
    ' it will not overwrite an existing query or local table with the name specified in LinkedTableAlias.
    'Links to a SQL Server table without the need to set up a DSN in the ODBC Console.
    Dim dbsCurrent As Database
    Dim tdfLinked As TableDef
    ' Open a database to which a linked table can be appended.
    Set dbsCurrent = CurrentDb()
    'Check for and deal with the scenario of the table alias already existing
    If TableNameInUse(LinkedTableAlias) Then
        If (Not OverwriteIfExists) Then
            Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite existing table."
            Exit Function
        End If
        'delete existing table, but only if it is a linked table
        If IsLinkedTable(LinkedTableAlias) Then
            dbsCurrent.TableDefs.Delete LinkedTableAlias
            dbsCurrent.TableDefs.Refresh
        Else
            Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite an existing query or local table."
            Exit Function
        End If
    End If
    'Create a linked table
    Set tdfLinked = dbsCurrent.CreateTableDef(LinkedTableAlias)
    tdfLinked.SourceTableName = SourceTableName
'    tdfLinked.Connect = "ODBC;DRIVER={SQL Server};SERVER=" & Server & ";DATABASE=" & Database & ";TRUSTED_CONNECTION=yes;"
 
    tdfLinked.Connect = "ODBC;" & BuildSQLConnectionString(Server, Database)
 
'    Dim AppTitle As Variant
'    AppTitle = BuildSQLConnectionString(Server, Database)
'    tdfLinked.Connect = AppTitle
 
    On Error Resume Next
    dbsCurrent.TableDefs.Append tdfLinked
    If (Err.Number = 3626) Then 'too many indexes on source table for Access
            Err.Clear
            On Error GoTo 0
            If LinkTable(LinkedTableAlias, Server, Database, "vw" & SourceTableName, OverwriteIfExists) Then
                Debug.Print "Can't link directly to table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Linked to view '" & "vw" & SourceTableName & "' instead."
                LinkTable = True
            Else
                Debug.Print "Can't link table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Create a view named '" & "vw" & SourceTableName & "' that selects all rows/columns from '" & SourceTableName & "' and try again to circumvent this."
                LinkTable = False
            End If
            Exit Function
    End If
    On Error GoTo 0
    tdfLinked.RefreshLink
    LinkTable = True
End Function
Function BuildSQLConnectionString(Server As Variant, DBName As Variant) As String
    BuildSQLConnectionString = "Driver={SQL Server};Server=" & Server & _
    ";APP=" & Application.CurrentDb.Properties("AppTitle").Value & _
    ";Database=" & DBName & ";TRUSTED_CONNECTION=yes;"
End Function
Function TableNameInUse(TableName As Variant) As Boolean
    'check for local tables, linked tables and queries (they all share the same namespace)
    TableNameInUse = DCount("*", "MSYSObjects", "(Type = 4 or type=1 or type=5) AND [Name]='" & TableName & "'") > 0
End Function
Function IsLinkedTable(TableName As Variant) As Boolean
    IsLinkedTable = DCount("*", "MSYSObjects", "(Type = 4) AND [Name]='" & TableName & "'") > 0
End Function
Public Function DeleteODBCTableNames(Optional stLocalTableName As String)
On Error GoTo Err_DeleteODBCTableNames
Dim dbs As Database, tdf As TableDef, i As Integer
Set dbs = CurrentDb
If Len(stLocalTableName) = 0 Then
    For i = dbs.TableDefs.Count - 1 To 0 Step -1
        Set tdf = dbs.TableDefs(i)
            If (tdf.Attributes And dbAttachedODBC) Then
                If tdf.Name = "R2IMAGE" Then
'                    Debug.Print "Skipped Table:" & vbTab & tdf.Name
                Else
'                    Debug.Print "Linked Table:" & vbTab & tdf.Name
                    dbs.TableDefs.Delete (tdf.Name)
                End If
            End If
    Next i
Else
'    Debug.Print "Local Table:  " & vbTab & stLocalTableName
    dbs.TableDefs.Delete (stLocalTableName)
End If
dbs.Close
Set dbs = Nothing
Exit_DeleteODBCTableNames:
Exit Function
Err_DeleteODBCTableNames:
MsgBox ("Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & Err.Description)
Resume Exit_DeleteODBCTableNames
End Function