Trong bài viết này, Học Excel Online sẽ hướng dẫn bạn cách tự động sao lưu một bản sao mới bằng VBA song song với tệp gốc. Việc kiểm soát các bản sao của tệp soạn thảo trở thành một điều cần thiết trong quá trình làm việc với các chương trình của bộ Microsoft Office. Nhận thấy nhu cầu đó, ứng dụng Microsoft Sharepoint đã được tạo ra để có thể hỗ trợ bạn lưu nhanh bản sao các tệp làm việc tức thì và không mất nhiều thời gian. Tuy vậy, nếu như bạn muốn việc sao lưu các bản sao này được diễn ra hoàn toàn tự động thì bạn hoàn toàn có thể sử dụng các mã lệnh VBA được trình bày dưới đây.
Kiến thức căn bản
Trước tiên ta cần tìm hiểu cách viết một mã lệnh đủ tiêu chuẩn. Dưới đây là các tiêu chí mà một mã lệnh VBA hoàn chỉnh cần đáp ứng được:
Đối với mỗi chương trình Excel, Word và Powerpoint, ta sẽ sử dụng một đoạn mã lệnh khác nhau để có thể tương thích với tất cả các dạng tài liệu. Giữa nội dung các đoạn mã thực chất không có quá nhiều sự khác biệt.
Đăng ký ngay: lớp học VBA ở Hà Nội
Xác định xem tệp gốc còn tồn tại hay không
Để lệnh VBA có thể hoạt động hiệu quả, bạn cần sử dụng một hàm chức năng nhỏ có tên FileExist để kiểm tra xem liệu còn tồn tại tệp gốc (thông qua đường dẫn chứa tệp) trong máy tính hay không. Việc này vô cùng quan trọng bởi nó sẽ giúp bạn xác định xem mình sẽ tạo bản sao thứ mấy cho tệp đó.
Đảm bảo chắc chắn rằng bạn luôn sử dụng hàm này trước khi chạy các chuỗi mã lệnh khác, bằng cách sao chép và dán vào phía dưới các hàm thủ tục trong Word, Excel hay Powerpoint.
Function FileExist(FilePath As String) As Boolean
‘PURPOSE: Test to see if a file exists or not
‘SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
‘RESOURCE: http://www.rondebruin.nl/win/s9/win003.htm
Dim TestStr As String
‘Test File Path (ie “C:\Users\Chris\Desktop\Test\book1.xlsm”)
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0
‘Determine if File exists
If TestStr = “” Then
FileExist = False
Else
FileExist = True
End If
End Function
Mã lệnh VBA để kiểm soát bản sao tệp trong Excel
Trước tiên ta sẽ bắt đầu với Excel, và trong đoạn mã dưới đây bạn chỉ cần thay đổi duy nhất 1 giá trị của biến số VersionExt. Ký tự đuôi được thêm vào sẽ được mặc định có dạng “_v” (ví dụ như “myReport_v2.xlsx”) nhưng bạn hoàn toàn có thể dễ dàng sửa thành “ v” ( ví dụ như “myReportv2.xlsx”), hoặc bất kỳ dạng ký tự đuôi nào mà bạn thích.
Lưu ý là bạn luôn phải sử dụng hàm FileExist trong mô-đun lệnh để kiểm tra sự tồn tại của tệp gốc.
Sub SaveNewVersion_Excel()
‘PURPOSE: Save file, if already exists add a new version indicator to filename
‘SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
TestStr = “”
Saved = False
x = 2
‘Version Indicator (change to liking)
VersionExt = “_v”
‘Pull info about file
On Error GoTo NotSavedYet
myPath = ActiveWorkbook.FullName
myFileName = Mid(myPath, InStrRev(myPath, “\”) + 1, InStrRev(myPath, “.”) – InStrRev(myPath, “\”) – 1)
FolderPath = Left(myPath, InStrRev(myPath, “\”))
SaveExt = “.” & Right(myPath, Len(myPath) – InStrRev(myPath, “.”))
On Error GoTo 0
‘Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If
‘Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & SaveExt
Exit Sub
End If
‘Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
Saved = True
Else
x = x + 1
End If
Loop
‘New version saved
MsgBox “New file version saved (version ” & x & “)”
Exit Sub
‘Error Handler
NotSavedYet:
MsgBox “This file has not been initially saved. ” & _
“Cannot save a new version!”, vbCritical, “Not Saved To Computer”
End Sub
Mã lệnh VBA để kiểm soát bản sao tệp trong Word
Bạn chỉ cần thay đổi biến số duy nhất trong đoạn mã trên áp dụng cho Excel, đó là chuyển từ ActiveWorkbook sang ActiveDocument. Còn lại tất cả nội dung mã lệnh được giữ y nguyên.
Lưu ý là bạn luôn phải sử dụng hàm FileExist trong mô-đun lệnh để kiểm tra sự tồn tại của tệp gốc.
Sub SaveNewVersion_Word()
‘PURPOSE: Save file, if already exists add a new version indicator to filename
‘SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
TestStr = “”
Saved = False
x = 2
‘Version Indicator (change to liking)
VersionExt = “_v”
‘Pull info about file
On Error GoTo NotSavedYet
myPath = ActiveDocument.FullName
myFileName = Mid(myPath, InStrRev(myPath, “\”) + 1, InStrRev(myPath, “.”) – InStrRev(myPath, “\”) – 1)
FolderPath = Left(myPath, InStrRev(myPath, “\”))
SaveExt = “.” & Right(myPath, Len(myPath) – InStrRev(myPath, “.”))
On Error GoTo 0
‘Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If
‘Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActiveDocument.SaveAs FolderPath & SaveName & SaveExt
Exit Sub
End If
‘Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActiveDocument.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
Saved = True
Else
x = x + 1
End If
Loop
‘New version saved
MsgBox “New file version saved (version ” & x & “)”
Exit Sub
‘Error Handler
NotSavedYet:
MsgBox “This file has not been initially saved. ” & _
“Cannot save a new version!”, vbCritical, “Not Saved To Computer”
End Sub
Mã lệnh VBA để kiểm soát bản sao tệp trong Powerpoint
Bạn chỉ cần thay đổi biến số duy nhất trong đoạn mã trên áp dụng cho Excel, đó là chuyển từ ActiveWorkbook sang ActivePresentation. Còn lại tất cả nội dung mã lệnh được giữ y nguyên.
Lưu ý là bạn luôn phải sử dụng hàm FileExist trong mô-đun lệnh để kiểm tra sự tồn tại của tệp gốc.
Sub SaveNewVersion_PowerPoint()
‘PURPOSE: Save file, if already exists add a new version indicator to filename
‘SOURCE: www.TheSpreadsheetGuru.com/The-Code-Vault
Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long
TestStr = “”
Saved = False
x = 2
‘Version Indicator (change to liking)
VersionExt = “_v”
‘Pull info about file
On Error GoTo NotSavedYet
myPath = ActivePresentation.FullName
myFileName = Mid(myPath, InStrRev(myPath, “\”) + 1, InStrRev(myPath, “.”) – InStrRev(myPath, “\”) – 1)
FolderPath = Left(myPath, InStrRev(myPath, “\”))
SaveExt = “.” & Right(myPath, Len(myPath) – InStrRev(myPath, “.”))
On Error GoTo 0
‘Determine if file has ever been saved
If FolderPath = “” Then
MsgBox “This file has not been initially saved. ” & _
“Cannot save a new version!”, vbCritical, “Not Saved To Computer”
Exit Sub
End If
‘Determine Base File Name
If InStr(1, myFileName, VersionExt) > 1 Then
myArray = Split(myFileName, VersionExt)
SaveName = myArray(0)
Else
SaveName = myFileName
End If
‘Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActivePresentation.SaveAs FolderPath & SaveName & SaveExt
Exit Sub
End If
‘Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActivePresentation.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
Saved = True
Else
x = x + 1
End If
Loop
‘New version saved
MsgBox “New file version saved (version ” & x & “)”
Exit Sub
‘Error Handler
NotSavedYet:
MsgBox “This file has not been initially saved. ” & _
“Cannot save a new version!”, vbCritical, “Not Saved To Computer”
End Sub