Dim MyTableName As String Dim MyFieldName As String Dim GetFieldDesc_ADO Dim GetFieldDescription MyTableName = "ke_hu" MyFieldName = "dw_name"
Dim MyDB As New ADOX.Catalog Dim MyTable As ADOX.Table Dim MyField As ADOX.Column
On Error GoTo Err_GetFieldDescription
MyDB.ActiveConnection = CurrentProject.Connection Set MyTable = MyDB.Tables(MyTableName) GetFieldDesc_ADO = MyTable.Columns(MyFieldName).Properties("Description")
Dim pro As ADODB.Property For Each pro In MyTable.Columns(MyFieldName).Properties Debug.Print pro.Name " : " pro.Value " ---- type : " pro.Type Next
With MyTable.Columns(MyFieldName)
'.Properties("nullable") = True '必填 '必填無法用上述代碼設置,出錯提示為: '多步 OLE DB 操作產生錯誤。如果可能,請檢查每個 OLE DB 狀態值。沒有工作被完成。 '目前可以用以下語句設置: 'CurrentDb.TableDefs("ke_hu").Fields("DW_NAME").Properties("Required") = False .Properties("Jet OLEDB:Allow Zero Length") = True '允許空 .Properties("default") = "默默默默認認認認" '默認值 End With Set MyDB = Nothing
Dim tdf As TableDef Dim fld As Field Dim db As Database Dim pro As Property
Set db = CurrentDb
For Each tdf In db.TableDefs For Each fld In tdf.Fields If fld.Type = dbText Then If DBEngine.Errors(0).Number = 3270 Then Set pro = fld.CreateProperty("UnicodeCompression", 1, 0) fld.Properties.Append p End If fld.Properties("UnicodeCompression") = True End If Next fld Next tdf End Sub