vulhu06 > 10-03-17, 10:05 AM
ongke0711 > 10-03-17, 10:55 AM
maidinhdan > 10-03-17, 11:19 PM
(10-03-17, 10:05 AM)vulhu06 Đã viết: Chào các ACE trên diễn đàn!
Số là mình có tham khảo demo dọn rác 1 tháng 1 lần (compact and repair) của bác MaidinhDan, với đoạn code như sau (xin phép bác Maidinhdan):
Public Sub CompactDB()
CommandBars("Menu Bar"). _
Controls("Tools"). _
Controls("Database utilities"). _
Controls("Compact and repair database..."). _
accDoDefaultAction
End Sub
Với đoạn code này thì sẽ truy xuất được menu bar trong Access 2003, thế nhưng khi mình mở trên Access 2010/ 2013 thì báo lỗi Sub này. Mình muốn hỏi là vậy muốn truy xuất các controls trong Ribbon của Access phên bản cao hơn thì code như thế nào ah?
Các ACE có cao kiến xin hướng dẫn
Xin cám ơn
Function RepairDatabase(DuongdanfileNguon As String, Duongdanfiledarepair As String) As Boolean
RepairDatabase = Access.Application.CompactRepair(DuongdanfileNguon , Duongdanfiledarepair , True)
End Function
Application.SetOption "Auto compact", True
Function NenAccess()
Dim AccessVer As Integer
On Error GoTo Loi
AccessVer = SysCmd(acSysCmdAccessVer) ' Xác định phiên bản Access bạn đang là Version mấy
If AccessVer < 12 Then ' Nén file Access từ 2007 trở xuống
CommandBars("Menu Bar").Controls("Tools").Controls("Database utilities").Controls("Compact and repair database...").accDoDefaultAction
DoCmd.Quit
Else
If SysCmd(acSysCmdAccessVer) = 12 Then ' Nén file Access 2007
SendKeys "%(FMC)", False
Else ' Nén file Access cao hơn 2007
SendKeys "%(YC)", False
End If
DoCmd.Quit
End If
Loi:
Exit Function
Loi:
MsgBox Err.Description
Resume Loi
End Function
Public Function CompactDB()
Dim strWindowTitle As String
On Error GoTo err_Handler
strWindowTitle = Application.Name & " - " & Left(Application.CurrentProject.Name, Len(Application.CurrentProject.Name) - 4)
strScriptPath = Application.CurrentProject.Path & "\compact.vbs"
strCmd = "wscript " & """" & strScriptPath & """"
Open strScriptPath For Output As #1
Print #1, "Set WshShell = WScript.CreateObject(""WScript.Shell"")"
Print #1, "WScript.Sleep 1000"
Print #1, "WshShell.AppActivate " & """" & strWindowTitle & """"
Print #1, "WScript.Sleep 500"
Print #1, "WshShell.SendKeys ""%yc"""
Close #1
Shell strCmd, vbHide
Exit Function
err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Close #1
End Function
vulhu06 > 15-03-17, 11:42 AM
(10-03-17, 11:19 PM)maidinhdan Đã viết:(10-03-17, 10:05 AM)vulhu06 Đã viết: Chào các ACE trên diễn đàn!
Số là mình có tham khảo demo dọn rác 1 tháng 1 lần (compact and repair) của bác MaidinhDan, với đoạn code như sau (xin phép bác Maidinhdan):
Public Sub CompactDB()
CommandBars("Menu Bar"). _
Controls("Tools"). _
Controls("Database utilities"). _
Controls("Compact and repair database..."). _
accDoDefaultAction
End Sub
Với đoạn code này thì sẽ truy xuất được menu bar trong Access 2003, thế nhưng khi mình mở trên Access 2010/ 2013 thì báo lỗi Sub này. Mình muốn hỏi là vậy muốn truy xuất các controls trong Ribbon của Access phên bản cao hơn thì code như thế nào ah?
Các ACE có cao kiến xin hướng dẫn
Xin cám ơn
Trả lời ý 1: Phần phụ đối với chủ đề bài này
1. Nếu bạn muốn compact / Repair một tập tin Access 2010 hoặc cao hơn (không phải là file bạn đang sử dụng): thì dùng hàm sau
* Ghi chú: Nên sử dụng tham số True, nếu lở file gốc có hư hỏng thì nó cũng tạo ra một bản backup để bạn không bị mất fileMã PHP:Function RepairDatabase(DuongdanfileNguon As String, Duongdanfiledarepair As String) As Boolean
RepairDatabase = Access.Application.CompactRepair(DuongdanfileNguon , Duongdanfiledarepair , True)
End Function
2. Nếu bạn muốn compact/repair cho Access mặc định trên máy đó thì dùng hàm sau.
Mã PHP:Application.SetOption "Auto compact", True
Trả lời ý bạn hỏi: Code Nén dùng cho từ Access 2000, 2003, 2007, 2010, 2012, 2013. ( Chưa test)
Mã PHP:Function NenAccess()
Dim AccessVer As Integer
On Error GoTo Loi
AccessVer = SysCmd(acSysCmdAccessVer) ' Xác định phiên bản Access bạn đang là Version mấy
If AccessVer < 12 Then ' Nén file Access từ 2007 trở xuống
CommandBars("Menu Bar").Controls("Tools").Controls("Database utilities").Controls("Compact and repair database...").accDoDefaultAction
DoCmd.Quit
Else
If SysCmd(acSysCmdAccessVer) = 12 Then ' Nén file Access 2007
SendKeys "%(FMC)", False
Else ' Nén file Access cao hơn 2007
SendKeys "%(YC)", False
End If
DoCmd.Quit
End If
Loi:
Exit Function
Loi:
MsgBox Err.Description
Resume Loi
End Function
hoặc dùng hàm này trên Access 2010
Mã PHP:Public Function CompactDB()
Dim strWindowTitle As String
On Error GoTo err_Handler
strWindowTitle = Application.Name & " - " & Left(Application.CurrentProject.Name, Len(Application.CurrentProject.Name) - 4)
strTempDir = Environ("Temp")
strScriptPath = strTempDir & "\compact.vbs"
strCmd = "wscript " & """" & strScriptPath & """"
Open strScriptPath For Output As #1
Print #1, "Set WshShell = WScript.CreateObject(""WScript.Shell"")"
Print #1, "WScript.Sleep 1000"
Print #1, "WshShell.AppActivate " & """" & strWindowTitle & """"
Print #1, "WScript.Sleep 500"
Print #1, "WshShell.SendKeys ""%yc"""
Close #1
Shell strCmd, vbHide
Exit Function
err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Close #1
End Function
* Bạn test thử xem, nếu chưa được thì phản hồi. Nhưng tôi vẫn khuyên bạn nên sử dụng code theo ý số 1 mình trả lời.
maidinhdan > 17-03-17, 12:19 AM
vulhu06 Đã viết:Chào bác MaiDinhdan,
Trước tiên xin cám ơn Bác về sự trả lời rất nhiệt tình. Xin thỉnh giáo ý kiến thêm của Bác
1. Ứng dụng của mình là FE - BE. Tại file FE mình dùng dòng lệnh như sau: application.setoption "Auto compact",True (như Bác hướng dẫn)
2. File BE mình check vào mục Compact On close trong Option của Access, vì mình dùng Demo dọn rác file BackEnd của Bác nhưng bị báo lỗi Function AutoCompact () mà không biết vì sao nên dùng tạm thế này
Khi thoát hết Chương trình thì mình thấy nó cũng nén và làm giảm dung lượng File, nhưng mình muốn hỏi là làm như trên liệu có ổn không, File có bị hư hỏng gì không, vì mình cũng không rành cái vụ này
Cám ơn rất nhiều
kieu manh > 31-03-17, 12:20 AM
maidinhdan > 12-11-20, 05:04 PM
(31-03-17, 12:20 AM)kieu manh Đã viết: Mình nghĩ bài 13 xài hàm strTempDir = Environ("Temp") ...[Environ]
Nếu Máy bạn nào đặt tên là Tiếng Việt Có dấu là Mất tác dụng
VD: tên Computer: Kiều Mạnh
Sao bạn không xài Fso Nhỉ
Public Function CompactDB()
On Error GoTo Loi
Dim strTenUngdung As String
strTenUngdung = Application.Name & " - " & Left(Application.CurrentProject.Name, Len(Application.CurrentProject.Name) - 4)
strScriptPath = Application.CurrentProject.Path & "\compact.vbs"
strCmd = "wscript " & """" & strScriptPath & """"
Open strScriptPath For Output As #1
Print #1, "Set WshShell = WScript.CreateObject(""WScript.Shell"")"
Print #1, "WScript.Sleep 1000"
Print #1, "WshShell.AppActivate " & """" & strTenUngdung & """"
Print #1, "WScript.Sleep 500"
Print #1, "WshShell.SendKeys ""%yc"""
Close #1
Shell strCmd, vbHide
Exit Function
Loi:
MsgBox "Error " & Err.Number & ": " & Err.Description
Close #1
End Function