• <strong id="yd969"><track id="yd969"></track></strong>

    <li id="yd969"></li>
  • <rp id="yd969"><object id="yd969"></object></rp>
  • office交流網--QQ交流群號

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

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

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

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

    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"


      分享