hi all:)
my coding works correctly for compacting. but after opening any report (ie crystal report)it doesnt works.
here the errror mentioned is
error no 3049
cannot open database(filename).it may not be a databse that your application recongnizes or file may corrupt.
here is the code
Public Sub Compact_DB(DBF_Path)
On Error GoTo disp_err
Dim FSO As New FileSystemObject
Dim tmp_file1
Dim tmp_file2
' First Close all the Databases
If Dir(App.Path & "\PA_COMPACT.00~") <> "" Then
FSO.DeleteFile App.Path & "\PA_COMPACT.00~"
End If
If Dir(App.Path & "\PA_BK.BK") <> "" Then
FSO.CopyFile App.Path & "\PA_BK.BK", App.Path & "\PA_BK.BK1", True
End If
If Dir(App.Path & "\PA_COMPACT.00~") <> "" Then
FSO.DeleteFile App.Path & "\PA_COMPACT.00~"
End If
If Dir(App.Path & "\PAT_COMPACT.00~") <> "" Then
FSO.DeleteFile App.Path & "\PAT_COMPACT.00~"
End If
tmp_file1 = App.Path & "\" & "PA_COMPACT" & ".00~"
tmp_file2 = App.Path & "\" & "PAT_COMPACT" & ".00~"
If Dir(DBF_Path) = "" Then
tmp = MsgBox("The Database file at location : " & DBF_Path & " Not Found!!!" & vbLf & "Check the Server Status or Drive Mappings!!!", vbCritical, "Database Not Found!!!")
Exit Sub
Else
''' Delete all the temporaty tables in the database
If moConn.State = 1 Then
moConn.Close
End If
' moConn.Close
' moConn.Open
DBEngine.CompactDatabase DBF_Path, tmp_file1
'DBEngine.CompactDatabase DBF_Path1, tmp_file1
''Rename the Database to Original Name
Rename_File tmp_file1, DBF_Path
DoEvents
tmp = MsgBox("Compacted Successfully.", vbExclamation, "Compact")
End If
Exit Sub
disp_err:
tmp = MsgBox(Err.Description, vbCritical, "Compact : " & Err.Number)
Exit Sub
End Sub
Public Function Rename_File(Old_Name, New_Name) As Boolean
' Rename the file. If new name already exists it deletes it.
On Error GoTo disp_err
Dim OldName, NewName
If Dir(New_Name) <> "" Then
Kill New_Name
End If
OldName = Old_Name: NewName = New_Name ' Define file names.
DoEvents
Name OldName As NewName ' Rename file.
Rename_File = True
Exit Function
disp_err:
tmp = MsgBox(Err.Description, vbCritical, "Rename : " & Err.Number)
Rename_File = False
Resume Next
End Function
help us..