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, 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:

  • 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

Tác giả: dtnguyen (Nguyễn Đức Thanh)

@ Học Excel Online | DTNguyen.business
· · ·
Bài viết khác của cùng tác giả

Khóa học mới xuất bản

Bài viết liên quan