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

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"