office交流网--QQ交流群号

Access培训群:792054000         Excel免费交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

VBA DAO批量设置数据表字段的Unicode 压缩属性为真

2020-12-17 08:00:00
zstmtony
原创
748

VBA DAO批量设置数据表字段的Unicode 压缩属性为真


数据表中字段的属性Unicode压缩 如果设置为否,则导出到数据到Excel ,后面可能带有空格

如果表和字段非常多的话,如何批量设置字段属性 Unicode 压缩呢,经过不断尝试,终于成功了



代码如下:


Dim tdf As TableDef
 Dim prp As DAO.Property
 Dim fld As DAO.Field
 Dim db As DAO.Database
 Set db = CurrentDb   '必须要设置这个,直接用current.TableDefs("表1") 有问题
 Set tdf = db.TableDefs("表1")
 For Each fld In tdf.Fields
   If fld.Type = 10 Then fld.Properties("UnicodeCompression") = True
 
 Next

还可以尝试使用 sql 语句 或adox 的方法



Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
strSQL = "ALTER TABLE [Table] ADD COLUMN [Field] Text(40) WITH COMPRESSION"
cn.Execute strSQL



Dim TB As ADOX.Table
Dim FLD As ADOX.Column

For Each TB In Cat.Tables
    If Left(TB.Name, 4) <> "msys" And TB.Name = "表1" Then ' ignore system tables

        For Each FLD In TB.Columns

            ' only change Text & Memo fields
            If FLD.Type = adVarWChar _
                   Or FLD.Type = adLongVarWChar Then
                   ' FLD.Properties("Jet OLEDB:Allow Zero Length") = True

                    ' 以下代码好像有问题,还是使用dao更好:
                    FLD.Properties("Jet OLEDB:Compressed UNICODE Strings") = True
            End If
        Next

    End If
Next

MsgBox "Done"


    分享