Check this snippet out, it's very recent:
'---The location and file name for the artemis data feed is stored in the SysDefaults table
strArtSchLoc = tLookup("SysDefaultValue", "SYS_Defaults", "SysDefaultName='ArtSchLoc'")
strArtSchName = tLookup("SysDefaultValue", "SYS_Defaults", "SysDefaultName='ArtSchName'")
SysMsg = SysCmd(acSysCmdUpdateMeter, 2)
'---Check that the Artemis data is in the right place, else abort
If Dir(strArtSchLoc & strArtSchName) = "" Then
MsgBox "Data source may be missing or named incorrectly." & vbCr & _
"Check that " & strArtSchName & " is in the directory " & vbCr & _
strArtSchLoc & "." & vbCr & _
"Check the system defaults are configured correctly.", vbOKOnly + vbInformation, "Missing:"
booAbort = True
GoTo ExitPoint
End If
'---Before making new data and reports etc the existing data must be backed up
'---Backup is carried out into default directories as specified in the systems defaults table
'---First check that there is a directory to create the backups in
strArtSchBkDir = tLookup("SysDefaultValue", "SYS_Defaults", "SysDefaultName='ArtSchBakDir'")
If Dir(strArtSchBkDir, vbDirectory) = "" Then
MkDir strArtSchBkDir
End If
'---Now check that there is a backup directory for the year, and if not create it
strArtSchBkDir = strArtSchBkDir & Format(Date, "yyyy") & "\"
If Dir(strArtSchBkDir, vbDirectory) = "" Then
MkDir strArtSchBkDir
End If
'---Now check that there is a backup directory for the month, and if not create it
strArtSchBkDir = strArtSchBkDir & Format(Date, "mm") & "\"
If Dir(strArtSchBkDir, vbDirectory) = "" Then
MkDir strArtSchBkDir
End If
SysMsg = SysCmd(acSysCmdUpdateMeter, 3)
'---Now there is a directory export the SCH_MilestoneSchedule table to it
'---Set up the name for the database to export to, this is unique based on the date and time
strTblName = Format(Date, "yymmdd") & Format(Time, "hhnnss")
'---Now create the new database
Set dbsNew = Workspaces(0).CreateDatabase(strArtSchBkDir & strTblName & "_SCH_MilestoneSchedule.mdb", dbLangGeneral)
Set dbsNew = Nothing
SysMsg = SysCmd(acSysCmdUpdateMeter, 4)
'---Transfer the milestone schedule data to the new database
DoCmd.TransferDatabase acExport, "Microsoft Access", strArtSchBkDir & strTblName & "_SCH_MilestoneSchedule.mdb", acTable, "SCH_MilestoneSchedule", strTblName & "_SCH_MilestoneSchedule"
SysMsg = SysCmd(acSysCmdUpdateMeter, 5)
Troy Vinson
Trading as IT Supportman