MS Access VBA Append all Tables To a Single Table Function for versions 2000, 2002, 2003, 2007

Public Function CombineAllTables(TableName As String )

   'References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
   'Set references by Clicking Tools and Then References in the Code View window
   'Returns all Table Names that exist in The Current Database.
   ' Accepts
   'TableName: Name of table to create and append to
   '
   ' Ensures we do not overwrite existing tables.
   '
   'Will Create a Single table and append all other tables to it.
   '
   ' To work as advertised all Tables must have the same Field Names
   '
   'USAGE: CombineAllTables "TableName"

   On Error GoTo errhandler 'Capture any errors.
   Dim i As Integer , x As Integer , numTables As Integer , tabName As String
   Dim strSQL As String
   Dim Db As dao.Database, rs As dao.Recordset

   'Check if New Table Name exists
   If ifTableExists(TableName) Then
      MsgBox "Table " & TableName & " Exists, Operation Halted."
      Exit Function
   End If

   Set Db = CodeDb()

   'Make sure the Listbox is clear.
   Form_Make_Table_Append_ALL.lstTables.RowSourceType = "Value List"
   For x = 0 To Form_Make_Table_Append_ALL.lstTables.ListCount - 1

      If Form_Make_Table_Append_ALL.lstTables.ListCount - 1 > 0 Then

         If IsNull(Form_Make_Table_Append_ALL.lstTables.Column( 0 , x)) = False Then
            Form_Make_Table_Append_ALL.lstTables.RemoveItem Form_Make_Table_Append_ALL.lstTables.Column( 0 , x)
         End If

         If IsNull(Form_Make_Table_Append_ALL.lstTables.Column( 0 , x)) = True Then x =  0
      Else
         Form_Make_Table_Append_ALL.lstTables.RemoveItem  Form_Make_Table_Append_ALL.lstTables.Column( 0 , 0 )
         Exit For
      End If
   Next

   'Add Useable Tables to the Listbox
   numTables = CurrentDb.TableDefs.Count - 1
   For i = 0 To numTables

      'Set our Table Name string
      tabName = LCase(CurrentDb.TableDefs(i).Name)

      'Check for mssys prefixed tables and skip them
      If InStr( 1 , tabName, "msys" ) = False And _
            InStr( 1 , tabName, "~" ) = False Then

         'display the tables useing the Object to keep User Case sensitive Names
         Form_Make_Table_Append_ALL.lstTables.AddItem CurrentDb.TableDefs(i).Name

      End If
   Next

   'Loop through tables and Make the Main table
   'Then Append all the other Tables to it
   numTables = Form_Make_Table_Append_ALL.lstTables.ListCount - 1
   For i = 0 To numTables

      With Form_Make_Table_Append_ALL.lstTables

         'set table name
         tabName = .Column( 0 , i)

         'Check for the table to Create
         'If Not Present then Create it
         'Else append to it
         If ifTableExists(TableName) = False Then
            'Craft the SQL for the MakeTable Query
            'Add TYPE field to track the data from each Table 
          strSQL = "SELECT '" & tabName & "' AS TYPE, " & tabName & ".* INTO " & TableName & _
                  " FROM " & tabName & ";"
            'Debug.Print strSQL & " " & i

            'Run the SQL Query
            Db.Execute strSQL

         Else
            'Craft the SQL for the Append Query 
          strSQL = "INSERT INTO " & TableName & " SELECT " & tabName & ".*, '" &  tabName & _
                  "' AS TYPE FROM " & tabName & ";"
            'Debug.Print strSQL & " " & i

            'Run the SQL Query
            Db.Execute strSQL

         End If

      End With

   Next

   Db.Close

ExitHere:

   Set Db = Nothing
   'Notify User
   MsgBox "Append Complete"
   Exit Function

errhandler: 'Capture any Errors

   With Err
      MsgBox "Error " & .Number & vbCrLf & .Description, _
            vbOKOnly Or vbCritical, "CombineAllTables"
   End With
   Resume ExitHere
End Function