Automatic Back-up/compact of Data

[blurworld]

hi, another question

i'm trying to set-up an automatic means of nightly backing up and compacting the DATA (only) of an access database...

its using win2000, access2000...
i think you can do something with the task schedular but not sure,,, any ideas? thanx

-Martin

 

[smedvid]

I posted something recently that explained what I did... Can't locate it though... even has some code with it...
Basically, create an Autoexec macro that calls a function. Within the function I shell out to DOS, do a DIR of *.mdb and get a list. I then import the DIR into a table. Loop through the table and compact everything on the list.

Search for my post... But, here is the code chunk:

Function Main_One()
'This procedure will snapshot a directory listing of database files (*.mdb) and
'loop through that list attempting to perform an Access compact on each file.
'The purpose of this compacting is to establish a schedule to compact those
'Access databases located on a network drive and realize diskspace savings.
Dim thisdb As Database
Dim rsLog As DAO.Recordset
Dim rsBase As DAO.Recordset
Dim rsDirList As DAO.Recordset
Dim rsLastCompact As DAO.Recordset
Dim rsException As DAO.Recordset
Dim sFilePath As String
Dim oFSO As Scripting.FileSystemObject
Dim oFileOrig As Scripting.File
Dim oFileTemp As Scripting.File
Dim blnCompact As Boolean
Dim sTempName As String
Dim dOrigFileSize As Double
Dim dtOrigFileDate As Date
Dim sCommand As String
Dim wHandle As Long
Dim JobStart, StepStart
Dim ErrTrigger As Boolean
Dim lcError_Text As String
ErrTrigger = False

'Needed to Account for Wrong Access Version (95, 2000 or 2002) or Passworded Files and Skip File.
On Error GoTo Error_Trap

'mark the begining of the overall job so that its
'overall running time can be logged or governed
JobStart = Timer

Set thisdb = CurrentDb
Set rsBase = thisdb.OpenRecordset("select * from basepathlist&quot

If Not rsBase.BOF And Not rsBase.EOF Then
'get a filesystem object so that you can get sizes and modification times
Set oFSO = CreateObject("Scripting.FileSystemObject&quot

'create a directory listing by writing a batch file and executing it
sCommand = "dir " & rsBase("basepath&quot & "*.mdb /s /b >" & APP_PATH & "dir_list_mdb.lst"
Open APP_PATH & "dir.bat" For Output As #1
Print #1, sCommand
Close #1

'appLoop Shell(APP_PATH & "dir.bat&quot
wHandle = Shell(APP_PATH & "dir.bat&quot
'delay to wait for the directory list
'file to finish writing from the bat command. This is necessary becuase
'the Shell command is asyncronous
DelayTime 5
appLoop wHandle

'clear the working table
thisdb.Execute "delete from dir_list"

'load the directory listing into the working table
While Not rsBase.EOF
'open the directory list file and load it into a table
Open APP_PATH & "dir_list_mdb.lst" For Input As #1
Set rsDirList = thisdb.OpenRecordset("dir_list&quot
Do While Not EOF(1)
Input #1, sFilePath
'strip the base path to save the overall number of characters
If InStr(1, sFilePath, rsBase(&quot;basepath&quot) <> 0 Then
sFilePath = Mid(sFilePath, Len(rsBase(&quot;basepath&quot) + 1)
End If
'add it to the table
With rsDirList
.AddNew
.Fields(&quot;basepath&quot = rsBase(&quot;basepath&quot
.Fields(&quot;filepath&quot = sFilePath
.Update
End With
Loop 'end doloop not EOF(1)
Close #1

'get back to the begining of the list that you just loaded
rsDirList.MoveFirst
Do While Not rsDirList.EOF
'test to see if the file is on the exception list
Set rsException = thisdb.OpenRecordset(&quot;select 1 from Exception_list where basepath = '&quot; & rsBase(&quot;basepath&quot _
& &quot;' and filepath = '&quot; & rsDirList(&quot;filepath&quot & &quot;' &quot

'if the recordset has anything in it then it is on the exception list: skip to the bottom of the loop
If Not rsException.BOF And Not rsException.EOF Then GoTo NEXTDIRLIST

'test for when the file was last compacted and modified
Set rsLastCompact = thisdb.OpenRecordset(&quot;select iif(max(compact_datetime)is null, #01/01/1900#, max(compact_datetime)) &quot; _
& &quot;as maxcompact from actionlog &quot; _
& &quot;where basepath = '&quot; & rsBase(&quot;basepath&quot & &quot;' and filepath = '&quot; & rsDirList(&quot;filepath&quot & &quot;' &quot
If Not rsLastCompact.BOF And Not rsLastCompact.EOF Then
'if it is in the compacting window then has it been modified
If DateDiff(&quot;d&quot;, rsLastCompact(&quot;maxcompact&quot, Now()) > rsBase(&quot;compact_generation&quot Then
Set oFileOrig = oFSO.GetFile(rsDirList(&quot;basepath&quot & rsDirList(&quot;filepath&quot)
If DateDiff(&quot;d&quot;, oFileOrig.DateLastModified, Now()) > rsBase(&quot;modify_generation&quot Then
blnCompact = True
Else
blnCompact = False
End If
Else
blnCompact = False
End If
Else
blnCompact = True
End If

If blnCompact Then
'test to see if it is in use
If oFSO.FileExists(rsDirList(&quot;basepath&quot & Left(rsDirList(&quot;filepath&quot, Len(rsDirList(&quot;filepath&quot) - 3) & &quot;ldb&quot Then
GoTo NEXTDIRLIST
End If
StepStart = Timer
'create a temp file name
sTempName = Format(Now(), &quot;mmddyyyyhhnnss&quot & &quot;.mdb&quot;
'cop the file to the local drive for compacting
oFileOrig.Copy APP_PATH & oFileOrig.Name
'compact the database
DBEngine.CompactDatabase APP_PATH & oFileOrig.Name, APP_PATH & sTempName

If ErrTrigger = True Then
'Problem - Wrong Version or Other Incompatible File Format or Password - Unable to Compact!
Kill APP_PATH & oFileOrig.Name 'copy in the local directory
ErrTrigger = False
GoTo NEXTDIRLIST
End If

'*****deal with contingency on not geting an exclusive lock on the db
'get a handle on the compacted file
Set oFileTemp = oFSO.GetFile(APP_PATH & sTempName)
dOrigFileSize = oFileOrig.Size
dtOrigFileDate = oFileOrig.DateLastModified
'delete the originals
Kill APP_PATH & oFileOrig.Name 'copy in the local directory
oFileOrig.Delete 'orig in the orig location
'copy the compacted file into the place of the old
oFileTemp.Copy rsDirList(&quot;basepath&quot & rsDirList(&quot;filepath&quot

'update the log
thisdb.Execute (&quot;Insert into ActionLog (basepath,filepath,file_size,file_date_time,Compact_datetime,compact_size,elaps_minutes) Values(&quot; _
& &quot;'&quot; & rsDirList(&quot;basepath&quot & &quot;', '&quot; _
& rsDirList(&quot;filepath&quot & &quot;', &quot; _
& dOrigFileSize & &quot;, #&quot; & dtOrigFileDate & &quot;#, #&quot; _
& oFileTemp.DateLastModified & &quot;#, &quot; & oFileTemp.Size & &quot;, &quot; _
& (Timer - StepStart) / 60 & &quot &quot

'clear the temp file
oFileTemp.Delete
End If 'end if blnCompact

NEXTDIRLIST:
'only let the overall job run for eight hours (28800 seconds)
If ((Timer - JobStart) / 60) > 28800 Then Exit Function
'clean up
Set oFileOrig = Nothing
Set oFileTemp = Nothing
'go to the next item in the directory listing
rsDirList.MoveNext
Loop 'end while not rsdirlist.eof

rsBase.MoveNext
Wend 'end while not rsBase.eof


End If 'end if not rsBase.BOF/EOF

Error_Trap:
If Err.Number = 3343 Or Err.Number = 3031 Then
ErrTrigger = True
lcError_Text = &quot;Compact Failed Version/Password Problem&quot;
DoCmd.Beep
'update the log
thisdb.Execute (&quot;Insert into ActionLog (Basepath,FilePath,Comments) &quot; _
& &quot;Values( &quot; & &quot;'&quot; & rsDirList(&quot;basepath&quot & &quot;', '&quot; & rsDirList(&quot;filepath&quot & &quot;', '&quot; & lcError_Text & &quot;')&quot
Resume Next
End If
End Function Steve Medvid
&quot;IT Consultant & Web Master&quot;

 

[smedvid]

Also, u call the Access database from an NT Scheduled Event... Steve Medvid
&quot;IT Consultant & Web Master&quot;