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

Public Function fnCopyTables()
 On Error GoTo fnCopyTables_ErrorRoutine
'http://support.microsoft.com/kb/298174
 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
fnCopyTables_Resume_3044:
 Next

fnCopyTables_Exit:
 Exit Function

fnCopyTables_ErrorRoutine:
 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