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_CompactLink edDb
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("S cripting.FileSy stemObject")
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.Compac tDatabase 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_CompactLin kedDb:
DoCmd.Hourglass False
Exit Function
Err_CompactLink edDb:
DoCmd.Hourglass False
Resume Exit_CompactLin kedDb
End Function
code, the original db (File1) doesn't compact.
Thanks
Public Function CompactLinkedDb (File1 As String)
On Error GoTo Err_CompactLink edDb
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("S cripting.FileSy stemObject")
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.Compac tDatabase 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_CompactLin kedDb:
DoCmd.Hourglass False
Exit Function
Err_CompactLink edDb:
DoCmd.Hourglass False
Resume Exit_CompactLin kedDb
End Function