VBA/Excel/Access/Word/Access/Table Copy

Making a Copy of a Table

 
Sub Copy_Table()
   Dim conn As ADODB.Connection
   Dim strTable As String
   Dim strSQL As String
   On Error GoTo ErrorHandler
   strTable = "Customers"
   strSQL = "SELECT " & strTable & ".* INTO " & strTable & "Copy FROM " & strTable
   Debug.Print strSQL
   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & CurrentProject.Path & _
       "\mydb.mdb"
   conn.Execute strSQL
   conn.Close
   Set conn = Nothing
   MsgBox "The " & strTable & " table was copied."
   Exit Sub
ErrorHandler:
   If Err.Number = -2147217900 Then
      conn.Execute "DROP Table " & strTable & "Copy"
      Resume
   Else
      MsgBox Err.Number & ": " & Err.Description
   End If
End Sub