دستور ایجاد backup

[ali.b]

سلام و خسته نباشید
دوستان عزیز خیلی ها نیاز دارن که هر بار برای فایل اکسلشون تغییراتی میدن ی نسخه پشتبان گرفته بشه تا در صورت مشکل بتونن اخرین تغییرات رو پیدا کنن و یا فایل های قبلی رو هم داشته باشن
با این کد هر بار که تغییری در فایل اکسل میدین خودکار در مسیر مورد نظر ذخیره میکنه

Private Sub Workbook_Deactivate()

End Sub


Private Sub Workbook_Open()
      Application.Caption = "Microsoft Excel AutoBackup"
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
      Dim MyFilePath$, Extension$
      MyFilePath = MyPCpath("MyDocuments")
      Extension = Left(ThisWorkbook.Name, Len _
                                          (ThisWorkbook.Name) - 4) & " Backup"


      On Error Resume Next      '<< folder exists
      MkDir MyFilePath & Extension      '<< create folder
      'save current version of this book in the folder
      ActiveWorkbook.SaveCopyAs Filename:=MyFilePath & _
                                          Extension & "\" & Extension & _
                                          (Format(Now, " mmm d yyyy, hh.mm.ss AMPM")) & ".xls"
End Sub


Public Function MyPCpath$(Folder)
      MyPCpath = CreateObject("WScript.Shell").SpecialFolders _
                 (Folder) & Application.PathSeparator
End Function

برای اجرای ایکد باید اونو تو thisworkbook ذخیره کنین

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.