office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

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

VBA DAO批量設置數據錶字段的Unicode 壓縮屬性爲真

2020-12-17 08:00:00
zstmtony
原創
13925

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"


    分享