Append columns to ADP or MDB tables

=====================================ADP
Private Sub CmdRfhRts_Click()
   Dim i As Integer, HasIt As Boolean
  
   Dim rs1 As ADODB.Recordset
  
   Set rs1 = New ADODB.Recordset
  
   rs1.Open "Select * from System_MdlsRts Where MdlName='MK'", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
   If rs1.RecordCount = 0 Then Exit Sub
  
   SysCmd acSysCmdInitMeter, "Refreshing modles rights...", rs1.RecordCount
  
    ' Search for open AccessObject objects in AllTables collection.
   rs1.MoveFirst
        Dim tbl As ADOX.Table, fid As ADOX.column, fidn As New ADOX.column
        Dim cat As New ADOX.Catalog, cn As New ADODB.Connection
        Dim tes As String
        cn.ConnectionString = "Provider=SQLOLEDB.1;Password=mysql;Persist Security Info=True;User ID=sa;Initial Catalog=TaiShanERP;Data Source=MIS-JAMESCHS"
        cn.Open
        Set cat.ActiveConnection = cn
        Set tbl = cat.Tables("MK_Users")
        '.ParentCatalog = cat
       
   While Not rs1.EOF
     With tbl
          HasIt = False
          tes = rs1("RtsName")
          For Each fid In .Columns
            If fid.Name = tes Then  'have the field
              HasIt = True
              Exit For
            End If
          Next
          If Not HasIt Then  '彆羶衄涴跺趼僇憩崝樓珨跺
            fidn.Name = tes
            fidn.Type = adBoolean
            fidn.Attributes = adColNullable
            .Columns.Append fidn
            .Columns.Refresh
            Set fidn = Nothing
             'cat.Tables.Append tbl
          End If
     End With
     SysCmd acSysCmdUpdateMeter, rs1.AbsolutePosition
     rs1.MoveNext
   Wend
   SysCmd acSysCmdClearStatus
   Set tbl = Nothing
   Set cat.ActiveConnection = Nothing
   Set cat = Nothing
   Set cn = Nothing
   rs1.Close
   Set rs1 = Nothing
End Sub

====================================MDB=
'  mySql = "select * from 尺码表"
'  Set rs = New ADODB.Recordset
'    rs.Open mySql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
   
  Set rs = Me.尺码表子窗体.Form.RecordsetClone
 
  If rs.RecordCount = 0 Then Exit Sub
  With db1.TableDefs(rs1("TabName"))
        rs.MoveFirst
        While Not rs.EOF
          HasIt = False
          For i = 0 To .Fields.Count - 1
            If .Fields(i).Name = rs("尺码") Then  '如果有
              HasIt = True
              Exit For
            End If
          Next i
          If Not HasIt Then  '如果没有这个字段就增加一个
             If rs1("TabName") = "产品放码表" Then
             .Fields.Append .CreateField(rs("尺码"), dbText)
             Else
             .Fields.Append .CreateField(rs("尺码"), dbLong)
             End If
             .Fields(rs("尺码")).DefaultValue = 0
             TempSQL = ""
             TempSQL = "update " & rs1("TabName") & " set " & rs("尺码") & "=0"
             DoCmd.RunSQL TempSQL
          End If
          rs.MoveNext
        Wend
  End With