<form id="hbx9t"></form>

<noframes id="hbx9t">

    <em id="hbx9t"><span id="hbx9t"></span></em>

        <noframes id="hbx9t"><address id="hbx9t"><th id="hbx9t"><progress id="hbx9t"></progress></th></address>
        office交流網--QQ交流群號

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

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

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

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

        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"


          分享