Bài viết dưới đây bởi tác giả blogdaytinhoc.com. Bài viết chi tiết dể hiểu, hy vọng có ích với bạn đọc.
Với Excel, mất điện đột ngột, lỗi File, mặc dù trước đó bạn đã bấm lưu, nhưng khi mở ra dữ liệu vẫn có thể bị mất hoặc thậm tệ hơn là mất điện quá lâu và dữ liệu cũng không lưu.
Để giải quyết vấn đề sao lưu tự động bằng VBA, và bạn luôn tự tin File Excel luôn được lưu và được sao chép vào một thư mục lưu trữ quy định trong ổ đĩa, ở đây mình quy định Folder lưu trữ là "Backup", và nó tự động được tạo ra nếu không có sẵn trong ổ đĩa của bạn, còn nếu có sẵn nó sẽ tự biết Copy một bản dự phòng vào đó.


Chúng ta thực hiện các bước sau:
1Mở File bạn cần lưu tự động và thực hiện như sau
Mở cửa sổ soạn thảo Code ra, Nhấn ALT+F11 hoặc Developer, bấm chọn VisualBasic hoặc Viewcode để thực hiện viết code, bạn nào chưa biết cách làm tham khảo bài "VBA Cơ Bản Bài 01"
2Viết code cho sự kiện WorkbookOpen, gọi Code AutoBackup
Nháy đúp vào 'ThisWorkbook', bên phải chọn sự kiện Open nhé, như hình trên, một Private Sub cho sự kiện Open sẽ tự động sinh ra, bạn chỉ cần chép đoạn code này vào
Private Sub Workbook_Open()Application.OnTime Now + TimeValue("00:00:20"), "AutoBackup"End Sub
3Viết code cho Sub AutoBackup tại Module "mdAutoBackup"
Nhập đúp chuột vào Module "mdAutoBackup", và copy đoạn code sau dán vào trình soạn thảo VBA của Excel (Nhấn phím Alt + F11 trong màn hình làm việc của Excel).
Option ExplicitSub AutoBackup()Dim FileExtStr As StringDim FileFormatNum As LongDim xWs As WorksheetDim xWb As WorkbookDim FSO As ObjectDim MyPath As StringApplication.ThisWorkbook.SaveMyPath = ThisWorkbook.Path & "\Backup" '<< Duong dan thu muc ImportIf Right(MyPath, 1) = "\" ThenMyPath = Left(MyPath, Len(MyPath) - 1)End IfSet FSO = CreateObject("scripting.filesystemobject")If FSO.FolderExists(MyPath) = FALSE ThenMsgBox "Duong dan " & MyPath & "Thu muc Backup duoc tao!", vbInformationDim FolderName As StringApplication.ScreenUpdating = FALSESet xWb = Application.ThisWorkbookFolderName = xWb.Path & "\" & "Backup" '& DateStringMkDir FolderNameMsgBox "File cua ban se duoc luu tai " & MyPath, vbInformationThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\Backup\" & _Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "(" & _Right(Timer, 1) & ")" & Format(Date, "dd.mm.yyyy") & ".xlsm"ElseMsgBox "File cua ban se duoc luu tai " & MyPath, vbInformationThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\Backup\" & _Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "(" & _Right(Timer, 1) & ")" & Format(Date, "dd.mm.yyyy") & ".xlsm"End IfApplication.OnTime Now + TimeValue("00:00:20"), "AutoBackup"End Sub
Tại dòng code cuối cùng , mình đang để chế độ tự động lưu và Backup sau 20s, các bạn thay thế tùy ý nhé
nhatthienkt xin góp ý thêm:
- Nếu bạn muốn lưu với file định dạng .xlsb thì thay vào phần màu đỏ.
- Thay đổi thời gian tự động sao lưu thì chỉnh chỗ TimeValue("00:00:20")
0 Nhận xét
Vui lòng viết comment Tiếng Việt có dấu.
Emoji- Bạn có thể gửi mail trực tiếp qua địa chỉ: nhatthienkt.s@gmail.com
- Nhận xét không hỗ trợ cho người dùng ẩn danh
- Lưu ý những nhận xét với mục đích backlink không liên quan đến nội dung bài viết sẽ bị xóa bỏ
- Bạn muốn theo dõi cập nhật trả lời sớm nhất từ adm vui lòng tick vào ô "Thông báo cho tôi" rồi xuất bản nhận xét của mình.