Backup dữ liệu.

[quochung2005]

chào anh chị trong diễn đàn!
Mình mới sưu tập trên internet 1 marco backup dữ liệu mình muốn share cho mọi người, mình cũng không rành về VBA, các bạn có thể chỉnh sửa lại và lam theo ý mình !

Sub SaveWorkbookBackup()

Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean
    If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
    Set awb = ActiveWorkbook
    If awb.Path = "" Then
        Application.Dialogs(xlDialogSaveAs).Show
    Else
        BackupFileName = awb.FullName
        i = 0
        While InStr(i + 1, BackupFileName, ".") > 0
            i = InStr(i + 1, BackupFileName, ".")
        Wend
        If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
        BackupFileName = BackupFileName & ".backup"
        OK = False
        On Error GoTo NotAbleToSave
        With awb
            Application.StatusBar = "Saving this workbook..."
            .Save
            Application.StatusBar = "Saving this workbook backup..."
            .SaveCopyAs BackupFileName
            OK = True
        End With
    End If
NotAbleToSave:
    Set awb = Nothing
    Application.StatusBar = False
    If Not OK Then
        MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name
    End If
End Sub

marco trên thì back up cùng với file hiện hành (file nằm trong thư mục nào thì backup trong thư mục đó, có đuoi bachup.)
---------------
còn marco này thì chỉ đường dẫn VD D:\ thì lưu vào drive D:

Sub SaveWorkbookBackupTodrive()
Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean
    If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
    Set awb = ActiveWorkbook
    If awb.Path = "" Then
        Application.Dialogs(xlDialogSaveAs).Show
    Else
        BackupFileName = awb.Name
        OK = False
        On Error GoTo NotAbleToSave
        If Dir("D:" & BackupFileName) <> "" Then
            Kill "D:" & BackupFileName
        End If
        With awb
            Application.StatusBar = "Saving this workbook..."
            .Save
            Application.StatusBar = "Saving this workbook backup..."
            .SaveCopyAs "D:"& BackupFileName
            OK = True
        End With
    End If
NotAbleToSave:
    Set awb = Nothing
    Application.StatusBar = False
    If Not OK Then
        MsgBox "Backup Copy Not Saved!", vbExclamation, ThisWorkbook.Name
    End If
End Sub

 

[Đào Việt Cường]

Dear all,
-------
Tạo ra các bản sao cho mỗi phiên làm việc là một thói quen rất tốt. Bản sao sẽ giúp bạn khôi phục lại nếu như bạn vô tình lưu các thay đổi không mong muốn hoặc nhỡ tay xoá mất workbook nguồn. Nhưng tạo ra quá nhiều phiên bản đôi khi sẽ làm cho bạn cảm thấy phiền phức.
Mình thường tạo ra bản sao và cảm thấy rất thuận tiện mà lại không phải viết một đoạn code VBA nào. Bản sao này lưu trữ những gì bạn save trước đó, nghĩa là bạn luôn có một bản sao cho những thay đổi cuối cùng trước khi quyết định chắc chắn lưu lại các thay đổi. Mỗi lần lưu, bản sao mới sẽ thay thế cho bản sao hiện hành.
Bạn thực hiện việc này bằng cách:
- Chọn menu File/Save As (hoặc ấn F12)
- Chọn menu Tools/General Options, đánh dấu kiểm vào Always create backup
Bản sao sẽ được tạo ngay trong thư mục của workbook nguồn với tên có dạng: "Backup of <Workbook nguồn>.xlk"
Lưu ý, bạn không nên thay đổi tên cho bản sao này! (nếu có thay đổi thì MSE sẽ tự tạo ra bản khác)
Hi vọng đây cũng là một cách cho những người... ghét VBA!
Chúc dữ liệu kế toán của bạn an toàn hơn!

 

[tuankt007]

thanks

minh chay duoc backup nhung lam sao de doc file du lieu do ?
chi cho minh cach phuc hoi lai sau khi da backup nhe

 

[tuankt007]

quocchung2005 vui long chi cho minh cach phuc hoi lai du lieu sau khi backup nhe