VBA中修改DecimalPlaces属性无效求助（默认AUTO改0/2）

你的代码中导致DecimalPlaces属性无法生效的原因有两个关键错误：

1. CreateProperty的属性类型参数错误 #

设置DecimalPlaces属性时，你传递了字段的数据类型ID（vrFieldDataTypeNo）作为第二个参数，但实际上这个属性的数据类型固定为整数（dbInteger，对应数值3），和字段本身的数据类型无关。错误的类型参数会导致属性创建失败或无法正确写入数据库。

2. 未重新获取已追加表的TableDef引用 #

当你执行db.TableDefs.Append tdf后，内存中的tdf对象和数据库中实际的表对象已经脱节，后续对这个旧tdf对象的字段属性修改不会同步到数据库中，必须重新从db.TableDefs获取最新的引用。

修正后的代码 #

Sub test()
    fnReports 4
End Sub

Function fnReports(vrReportNo As Long)

    Dim db As DAO.Database
    Dim rsS As DAO.Recordset
    Dim vrSQL As String
    Dim vrTableName As String
    
    'create report table
     
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
 
    Set db = CurrentDb
    
    vrTableName = "mtMDAR" & vrReportNo
    
    vrSQL = "SELECT MDARReportFields.SortNoField, MDARReportFields.FieldName, MDARReportFields.FieldSize, FieldFormats.FieldFormat " & _
            ", MDARReportFields.FieldDecimalNo, FieldDataTypes.FieldDataTypeNo, FieldDataTypes.FieldDataType, FieldDataTypes.FieldDataTypeVBA " & _
            "FROM FieldFormats RIGHT JOIN (FieldDataTypes RIGHT JOIN MDARReportFields ON FieldDataTypes.FieldDataTypeID = MDARReportFields.FieldDataTypeID) " & _
            "ON FieldFormats.FieldFormatID = MDARReportFields.FieldFormatID WHERE MDARReportFields.ReportNo=" & vrReportNo & "  ORDER BY MDARReportFields.SortNoField"
    
    fnDeleteObjectIfExists "table", vrTableName
    Set tdf = db.CreateTableDef(vrTableName)
    
    Dim vrFieldName As String
    Dim vrFieldSize As Long
    Dim vrFieldFormat As String
    Dim vrFieldDecimalNo As Long
    Dim vrFieldDataTypeNo As Long
    Dim prp As DAO.Property
 
    Set rsS = db.OpenRecordset(vrSQL, dbOpenSnapshot)
   
    ' 第一步：创建字段并追加表到数据库
    Do Until rsS.EOF
     
        vrFieldName = rsS!FieldName
        vrFieldDataTypeNo = rsS!FieldDataTypeNo
        If vrFieldDataTypeNo = 10 Then
            vrFieldSize = rsS!FieldSize
        End If

        With tdf
            If vrFieldDataTypeNo = 10 Then
                Set fld = .CreateField(vrFieldName, vrFieldDataTypeNo, vrFieldSize)
            Else
                Set fld = .CreateField(vrFieldName, vrFieldDataTypeNo)
            End If
            .Fields.Append fld
        End With

        rsS.MoveNext
    Loop
 
    db.TableDefs.Append tdf
    ' 关键：追加后重新获取TableDef引用
    Set tdf = db.TableDefs(vrTableName)
    
    rsS.Close
    Set rsS = db.OpenRecordset(vrSQL, dbOpenSnapshot)
    
    ' 第二步：设置字段属性
    Do Until rsS.EOF
    
        vrFieldName = rsS!FieldName
        vrFieldDataTypeNo = rsS!FieldDataTypeNo
        If vrFieldDataTypeNo <> 5 And vrFieldDataTypeNo <> 10 Then
            vrFieldFormat = rsS!FieldFormat
            vrFieldDecimalNo = rsS!FieldDecimalNo
        End If
    
        With tdf
            Set fld = .Fields(vrFieldName)
         
            If vrFieldDataTypeNo <> 5 And vrFieldDataTypeNo <> 10 Then
                ' 关键：DecimalPlaces的类型固定为dbInteger（3）
                Set prp = fld.CreateProperty("DecimalPlaces", dbInteger, vrFieldDecimalNo)
                fld.Properties.Append prp
                 
                Set prp = fld.CreateProperty("Format", dbText, vrFieldFormat)
                fld.Properties.Append prp
            
            End If
  
        End With

        rsS.MoveNext
    Loop
 
    Set tdf = Nothing
    rsS.Close
    Set rsS = Nothing
    Set db = Nothing
    
End Function

关键修改点说明 #

• 在db.TableDefs.Append tdf之后，添加Set tdf = db.TableDefs(vrTableName)，确保后续操作的是数据库中实际存在的表对象。
• 设置DecimalPlaces属性时，将第二个参数从vrFieldDataTypeNo改为dbInteger（或直接写3），匹配该属性的正确数据类型。

内容的提问来源于stack exchange，提问作者Nata