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

Trong bài viết này, SprinGo 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:

• Kiểm tra được xem tệp gốc vẫn còn tồn tại hay không
• Kiểm tra xem vị trí đường dẫn nơi lưu trữ tệp gốc đó (hoặc thực tế là tệp đã được sao lưu hay chưa)
• Tạo 1 tệp bản sao mới và được đánh dấu ký tự đuôi đặc biệt để phân biệt (chẳng hạn bằng cách thêm “v2” vào đằng sau tên tệp)

Đố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

Địa chỉ học Excel tại Hà Nội