当通过ODBC(特别是AS / 400)链接到外部数据源时,我经常遇到另一边的隐藏字段名称,其中数据字典不可用。在极少数情况下,我能够从其他数据库中获取字段描述,我希望能够一次性导入它们,而不是一次一个地将每个描述复制/粘贴到表设计表单中。 / p>
我无法在系统表中找到它,所以我不知道这个元数据的存储位置。关于它在哪里的任何想法,以及它是否可以批量更新?
更新:我设法使用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
答案 0 :(得分:2)
使用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 :(得分:1)
一些可能有帮助的说明。以下显示了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