By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
454,105 Members | 1,048 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 454,105 IT Pros & Developers. It's quick & easy.

Compacting

P: n/a
Can anyone tell my why this code doesn't work. Using this
code, the original db (File1) doesn't compact.
Thanks

Public Function CompactLinkedDb(File1 As String)
On Error GoTo Err_CompactLinkedDb
Dim dblLength1 As Double
'the length in bytes of the db to be compacted
Dim dblLength2 As Double 'the length in bytes of the copy created
Dim File2 As String 'the name of a copy of the database
Dim File3 As String 'the name of the newly compacted database
Dim File4 As String 'the name of the previously saved backup
DoCmd.Hourglass True
Set fs = CreateObject("Scripting.FileSystemObject")
File2 = Left$(File1, InStr(1, File1, ".") - 1) & "2.mdb"
'set up the names of the files to be worked with
File3 = Left$(File1, InStr(1, File1, ".") - 1) & "3.mdb"
File4 = Left$(File1, InStr(1, File1, ".") - 1) & "4.mdb"
'if previous databases with these filenames
'exist, then delete them
If Dir(File2) <> "" Then Kill File2
If Dir(File3) <> "" Then Kill File3
'get the length of the original database
dblLength1 = FileLen(File1)
fs.CopyFile File1, File2
'then make a copy of it
dblLength2 = FileLen(File2)
'and get the length of the copy
If dblLength1 = dblLength2 Then
'if the copy length matches the original, proceed
DBEngine.CompactDatabase File2, File3
'to compact the copy into the 3.mdb extension
Else
MsgBox "Error in file copy"
'but if the lengths don't match generate an error msg
GoTo CLEANUP:
'and exit out of the routine
End If
If Dir(File4) <> "" Then Kill File4
'delete a previous file with a 4.mdb
Name File1 As Left$(File1, InStr(1, File1, ".") - 1) & "4.mdb"
'rename the original db with a 4.mdb
Name File3 As File1
'then rename the compacted db as the original
Kill File2
'then delete the copy of the original db
CompactLinkedDb = True
CLEANUP:
Set fs = Nothing
Exit_CompactLinkedDb:
DoCmd.Hourglass False
Exit Function
Err_CompactLinkedDb:
DoCmd.Hourglass False
Resume Exit_CompactLinkedDb
End Function
Nov 12 '05 #1
Share this question for a faster answer!
Share on Google+

This discussion thread is closed

Replies have been disabled for this discussion.