Sub cmdProcess_Click()
Dim ctr As Byte
Dim ctr2 As Byte
Dim rsFields As ADODB.Recordset
Dim strOrigTableName As String
Dim strNewTableName As String
Dim idxNewIndexes As Index
Dim strSortOrder As String
Dim strWhereStatement As String
Dim bytFieldCount As Byte
Dim bytIndexCount As Byte
Dim intPrimaryIndex As Integer
Dim colPrimaryFields As Collection
Dim bytPrimaryCount As Byte
Dim bolPrimaryOn As Boolean
CurrentDb.Execute "DELETE * FROM t_Field_List"
strOrigTableName = lstTableNames
intPrimaryIndex = -1
Set colPrimaryFields = New Collection
bytIndexCount = CurrentDb.TableDefs(strOrigTableName).Indexes.Count
If bytIndexCount > 0 Then
For ctr = 0 To bytIndexCount - 1
If CurrentDb.TableDefs(strOrigTableName).Indexes(ctr).Primary Then
intPrimaryIndex = ctr
bytPrimaryCount = CurrentDb.TableDefs(strOrigTableName).Indexes(ctr).Fields.Count
For ctr2 = 0 To CurrentDb.TableDefs(strOrigTableName).Indexes(ctr).Fields.Count - 1
colPrimaryFields.Add CurrentDb.TableDefs(strOrigTableName).Indexes(ctr).Fields(ctr2).Name
Next
End If
Next
End If
bytFieldCount = CurrentDb.TableDefs(strOrigTableName).Fields.Count
If bytFieldCount > 0 Then
For ctr = 0 To bytFieldCount - 1
bolPrimaryOn = False
For ctr2 = 1 To bytPrimaryCount
If colPrimaryFields(ctr2) = CurrentDb.TableDefs(strOrigTableName).Fields(ctr).Name Then
bolPrimaryOn = True
End If
Next
CurrentDb.Execute "INSERT INTO t_Field_List (FieldName, FieldType, FieldSize, IsPrimaryField) VALUES ('" & _
CurrentDb.TableDefs(strOrigTableName).Fields(ctr).Name & "', '" & _
CurrentDb.TableDefs(strOrigTableName).Fields(ctr).Type & "', " & _
CurrentDb.TableDefs(strOrigTableName).Fields(ctr).Size & ", " & _
bolPrimaryOn & ");"
Next
End If
strNewTableName = lstTableNames & "_NEW"
strSortOrder = Switch(fraSortOrder = 1, "ASC", True, "DESC")
strWhereStatement = Switch(chkPrimaryKeyTop, "WHERE IsPrimaryField = True", True, "")
CurrentDb.Execute "CREATE TABLE " & strNewTableName & ";"
Set rsFields = New ADODB.Recordset
If strWhereStatement <> "" Then
rsFields.Open "SELECT * FROM t_Field_List " & strWhereStatement & " ORDER BY FieldName " & strSortOrder, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If Not rsFields.EOF Then
With rsFields
.MoveFirst
While Not .EOF
CurrentDb.TableDefs(strNewTableName).Fields.Append CurrentDb.TableDefs(strNewTableName).CreateField(.Fields("FieldName"), .Fields("FieldType"), .Fields("FieldSize"))
.MoveNext
Wend
.Close
End With
End If
strWhereStatement = "WHERE IsPrimaryField = False"
End If
rsFields.Open "SELECT * FROM t_Field_List " & strWhereStatement & " ORDER BY FieldName " & strSortOrder, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
With rsFields
.MoveFirst
While Not .EOF
CurrentDb.TableDefs(strNewTableName).Fields.Append CurrentDb.TableDefs(strNewTableName).CreateField(.Fields("FieldName"), .Fields("FieldType"), .Fields("FieldSize"))
.MoveNext
Wend
.Close
End With
bytIndexCount = CurrentDb.TableDefs(strOrigTableName).Indexes.Count
If bytIndexCount > 0 Then
For ctr = 0 To bytIndexCount - 1
Set idxNewIndexes = CurrentDb.TableDefs(strNewTableName).CreateIndex
idxNewIndexes.Name = CurrentDb.TableDefs(strOrigTableName).Indexes(ctr).Name
bytFieldCount = CurrentDb.TableDefs(strOrigTableName).Indexes(ctr).Fields.Count
If bytFieldCount > 0 Then
For ctr2 = 0 To bytFieldCount - 1
idxNewIndexes.Fields.Append idxNewIndexes.CreateField(CurrentDb.TableDefs(strOrigTableName).Indexes(ctr).Fields(ctr2).Name)
If CurrentDb.TableDefs(strOrigTableName).Indexes(ctr).Primary Then
idxNewIndexes.Primary = True
End If
Next
End If
CurrentDb.TableDefs(strNewTableName).Indexes.Append idxNewIndexes
Next
End If
Set rsFields = Nothing
Set colPrimaryFields = Nothing
End Sub