Как заполнить описания полей в MS Access - PullRequest
3 голосов
/ 01 июня 2009

При связывании с внешним источником данных через ODBC (особенно в AS / 400) я часто сталкиваюсь с загадочными именами полей на другой стороне, где словарь данных недоступен. В тех редких случаях, когда я могу получить описания полей из другой базы данных, я хотел бы иметь возможность импортировать их все сразу, а не копировать / вставлять каждое описание в форму дизайна таблицы по одному.

Мне не удалось найти это в системных таблицах, поэтому я не знаю, где хранятся эти метаданные. Любые идеи о том, где он находится, и может ли он быть обновлен в пакетном режиме?

Обновление: мне удалось прочитать схему с помощью метода OpenSchema (см. Код ниже), но это возвращает набор данных только для чтения, что делает невозможным обновление описаний.

Function UpdateFieldDescriptions()
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim rs2 As Recordset
Dim strSQL As String
Dim strDesc As String

Set cn = CurrentProject.Connection
Set rs = cn.OpenSchema(adSchemaColumns)

While Not rs.EOF
    If Left(rs!table_name, 4) <> "MSys" Then
        Debug.Print rs!table_name, rs!column_name, rs!Description
        strSQL = "SELECT Description " & _
            "FROM tblColumnDescriptions a " & _
            "WHERE a.Name = """ & rs!table_name & """ AND " & _
            "a.Column = """ & rs!column_name & """;"
        Set rs2 = CurrentDb.OpenRecordset(strSQL)
        While Not rs2.EOF
            strDesc = rs2.Fields(0)
            rs!Description = strDesc ' <---This generates an error
        Wend
    End If
    rs.MoveNext
Wend

rs.Update
rs.Close
Set rs = Nothing
Set rs2 = Nothing
Set cn = Nothing

End Function

Ответы [ 2 ]

2 голосов
/ 26 августа 2009

Используйте DAO вместо ADO:

Sub SetFieldDesc(TblName As String, FldName As String, Description As String)
Dim db As DAO.Database, td As DAO.TableDef, fld As DAO.Field

    Set db = CurrentDb()
    Set td = db.TableDefs(TblName)
    Set fld = td.Fields(FldName)

    On Error Resume Next
    fld.Properties("Description") = Description
    If Err.Number = 3270 Then 'Property not found.'
        fld.Properties.Append fld.CreateProperty("Description", dbText, Description)
    End If
End Sub
1 голос
/ 01 июня 2009

Некоторые заметки, которые могут помочь. Ниже приведены описания полей из adSchemaColumns.

   Function ListFieldDescriptions()
   ''List field descriptions
   Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
   Dim rs As ADODB.Recordset, rs2 As ADODB.Recordset

       Set cn = CurrentProject.Connection

       Set rs = cn.OpenSchema(adSchemaTables, _
           Array(Empty, Empty, Empty, "tablenamehere"))

       While Not rs.EOF
           Debug.Print rs!table_name; "   desc=  "; rs!Description
           Set rs2 = cn.OpenSchema(adSchemaColumns, _
               Array(Empty, Empty, "" & rs!table_name & ""))
           While Not rs2.EOF
               Debug.Print "     " & rs2!Column_Name
               Debug.Print "     " & rs2!Data_Type
               Debug.Print "     " & rs2!Description
               Debug.Print "     " & rs2!Is_Nullable
               rs2.MoveNext
           Wend
       rs.MoveNext
       Wend
       rs.Close
       Set cn = Nothing

   End Function    

От: http://wiki.lessthandot.com/index.php/ADO_Schemas

...