Setting Field Descriptions on Linked SQL Server Tables

This is Part 4 in a series of articles discussing field comments on linked tables.

In part 3, I presented a VBA function that generates the T-SQL to UPSERT a column description.  By integrating that function into a broader schema management utility, you can simplify the process of documenting your SQL Server tables.

Unfortunately, that's only half the battle.  You see, unlike linking to MS Access tables, linking to SQL Server tables does not automatically transfer the column descriptions from SQL Server to the TableDef object in the front-end Access application.  Luckily, that's a process we can automate.

Transferring field comments to the TableDef object

I'll just jump right into the code and let the comments speak for themselves:

'Extracts the column descriptions from a SQL Server
'   source table and sets those descriptions
'   to the local front-end TableDef links.
Sub PullColDescs(td As DAO.TableDef, AdoCnString As String)
    
    'Extract the source schema and table name
    '   from the TableDef's .SourceTableName property
    Dim SchemaName As String
    SchemaName = Split(td.SourceTableName, ".")(0)
    
    Dim SrcTblName As String
    SrcTblName = Split(td.SourceTableName, ".")(1)
    
    
    'Build a T-SQL string to look up the column descriptions
    Dim s As String
    s = s & vbNewLine & "SELECT objname AS ColName, value As ColDesc"
    s = s & vbNewLine & "FROM fn_listextendedproperty"
    s = s & vbNewLine & "('MS_Description'"
    s = s & vbNewLine & ",'schema', '" & SchemaName & "'"
    s = s & vbNewLine & ",'table', '" & SrcTblName & "'"
    s = s & vbNewLine & ",'column', default)"
    
    'Open an ADO connection to SQL Server
    Dim AdoCn As Object
    Set AdoCn = CreateObject("ADODB.Connection")
    AdoCn.ConnectionString = AdoCnString
    AdoCn.Open
    
    'Open an ADO recordset using the above connection
    Const adUseServer As Long = 2
    Const adLockReadOnly As Long = 1
    Dim AdoRs As Object
    Set AdoRs = CreateObject("ADODB.Recordset")
    AdoRs.Open s, AdoCn, adUseServer, adLockReadOnly
    
    'Loop through the recordset
    With AdoRs
        Do Until .EOF
            Const MaxCommentLength As Long = 255
            
            Debug.Print !ColName, !ColDesc
            SetColDesc td.Fields(!ColName), _
                       Left(!ColDesc, MaxCommentLength)
            .MoveNext
        Loop
    End With
    
End Sub

'Set the column description for a DAO Field object
Private Sub SetColDesc(Fld As DAO.Field, Description As String)
    On Error Resume Next
    'Attempt to set existing property
    Fld.Properties("Description") = Description
    
    'Create the property if it does not exist
    If Err.Number = 3270 Then 'Property does not exist
        Dim Prop As DAO.Property
        Set Prop = Fld.CreateProperty( _
                                "Description", _
                                DataTypeEnum.dbText, _
                                Description)
        Fld.Properties.Append Prop
    End If
End Sub

Sample usage

Let's run a quick test:

Sub TestPullColDescs()
    Dim CnStr As String
    CnStr = "Provider=MSOLEDBSQL;" & _
            "Integrated Security=SSPI;" & _
            "Persist Security Info=False;" & _
            "Initial Catalog=NoLongerSet;" & _
            "Data Source=."
    
    PullColDescs CurrentDb.TableDefs("Account"), CnStr
    
End Sub

If we call TestPullColDescs from the Immediate window, here are the results:

And here is the linked table with the updated descriptions:

Image by Rudy and Peter Skitterians from Pixabay

UPDATED [2021-06-01]: Changed name of subroutine from SetColDescs to PullColDescs to better align with the reverse function PushColDescs introduced in Part 6 of this series.