VBA DAO批量設(shè)置數(shù)據(jù)表字段的Unicode 壓縮屬性為真

VBA DAO批量設(shè)置數(shù)據(jù)表字段的Unicode 壓縮屬性為真

數(shù)據(jù)表中字段的屬性Unicode壓縮 如果設(shè)置為否，則導(dǎo)出到數(shù)據(jù)到Excel ，后面可能帶有空格

如果表和字段非常多的話，如何批量設(shè)置字段屬性 Unicode 壓縮呢，經(jīng)過不斷嘗試，終于成功了

代碼如下：

Dim tdf As TableDef
 Dim prp As DAO.Property
 Dim fld As DAO.Field
 Dim db As DAO.Database
 Set db = CurrentDb   '必須要設(shè)置這個(gè)，直接用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"