Noname > 23-08-10, 04:11 PM
Sub CreateDatabaseX(DBname as String)
Dim wrkDefault As Workspace
Dim Bomtemp As Database
'Dim prpLoop As Property
' Get default Workspace.
Set wrkDefault = DBEngine.Workspaces(0)
' Make sure there isn't already a file with the name of
' the new database.
If Dir(CurrentProject.Path & "\" & "DBName") <> "" Then Kill CurrentProject.Path & "\"& DBName
' Create a new encrypted database with the specified
' collating order.
Set Bomtemp = wrkDefault.CreateDatabase(CurrentProject.Path & "\" & "DBname", dbLangGeneral, dbEncrypt)
Bomtemp.Close
End Sub
Sub ExportTable(T As String, DBname)
On Error GoTo err
DoCmd.TransferDatabase acExport, "Microsoft Access", CurrentProject.Path & "\" & "DBname", acTable, T, T
Exit Sub
err:
If err.Number = 3024 Then
CreateDatabaseX DBname
ExportTable T
End If
End Sub
autokiss > 17-03-12, 01:26 PM
autokiss > 02-04-12, 09:45 AM