maidinhdan > 19-01-19, 04:45 PM
Public Function CompactFileKhac(DiaChiFileCanNen As String, Optional DiaChiFileDaNen As String = "", Optional MatKhauFile As String = "")
On Error GoTo Loi
Dim MaLoi As Single, TenLoi As String
Dim objEngine As DAO.DBEngine
Set objEngine = Application.DBEngine
DoCmd.Hourglass True
' Compact CSDL hien tai DiaChiFileCanNen.
If DiaChiFileDaNen = "" Or DiaChiFileDaNen = DiaChiFileCanNen Then
MaLoi = 1
DiaChiFileDaNen = Application.CurrentProject.Path & "\TaptinTam.MDB"
If MatKhauFile = "" Then
objEngine.CompactDatabase DiaChiFileCanNen, DiaChiFileDaNen
Else
objEngine.CompactDatabase DiaChiFileCanNen, DiaChiFileDaNen, , , ";pwd=" & MatKhauFile
End If
' Delete file Goc.
Kill DiaChiFileCanNen
' Doi ten File Da nen thanh file Goc.
Name DiaChiFileDaNen As DiaChiFileCanNen
' Compact CSDL va xuat sang mot tap tin moi (DiaChiFileDaNen).
Else
If MatKhauFile = "" Then
objEngine.CompactDatabase DiaChiFileCanNen, DiaChiFileDaNen
Else
objEngine.CompactDatabase DiaChiFileCanNen, DiaChiFileDaNen, , , ";pwd=" & MatKhauFile
End If
End If
MsgBox "Da Compact xong file: " & LaytenFile(DiaChiFileCanNen), vbInformation, "Thông báo thanh cong"
KetThuc_Loi:
DoCmd.Hourglass False
Set objEngine = Nothing
Exit Function
Loi:
MaLoi = Err.Number
Debug.Print MaLoi
Select Case MaLoi
Case 3031: TenLoi = "Mat khau: [ " & MatKhauFile & " ] khong chinh xac"
Case 3204: TenLoi = "File nen: [ " & DiaChiFileDaNen & " ] dang ton tai, vui long xem lai"
Case 3024: TenLoi = "File chon khong phai la file Access"
Case Else: TenLoi = "Chua xac dinh dc loi"
End Select
MsgBox "Nguyen nhan Loi: " & TenLoi, vbCritical, "Loi ham Compact and Repaire"
Resume KetThuc_Loi
End Function
CompactFileKhac "Địa chỉ file cần nén"
CompactFileKhac "Địa chỉ file cần nén", Nz("Địa chỉ file đã nén với tên mới:")
CompactFileKhac "Địa chỉ file cần nén", , Nz("Mật khẩu file cần nén")
CompactFileKhac "Địa chỉ file cần nén", Nz("Địa chỉ file đã nén với tên mới:"), Nz("Mật khẩu file cần nén")