VBA function to copy tables to an empty database to remove Access security for Access 2010

Public Function fnCopyTables()
 On Error GoTo fnCopyTables_ErrorRoutine
 Dim db As Database 'Database to import
 Dim tdf As TableDef
 Dim sTablename As String
 Dim sPath As String
 sPath = fnFileDialog
 Set db = DBEngine.Workspaces(0).OpenDatabase(sPath, True)
 For Each tdf In db.TableDefs
  sTablename = tdf.Name
  Debug.Print sTablename
  If Left(sTablename, 4) <> "MSys" Then
   DoCmd.TransferDatabase _
   		acImport, "Microsoft Access", sPath, acTable, sTablename, sTablename, False
  End If

 Exit Function

 Select Case Err.Number
 Case 3044 ' 3044 blah is not a valid path
' Do not copy bad links
' This database needs to be able to see the same as the target database so it can check links
  MsgBox "** Bad Link : " & sTablename & " - Path - " & tdf.Connect
  Resume fnCopyTables_Resume_3044
 Case Else
  MsgBox "** Error Number : " & Err.Number & vbCrLf & Err.Description, , "Error message"
  Resume fnCopyTables_Exit
 End Select
End Function