ذخیره کردن خودکار فایل اکسل هر چند ساعت یکبار

**مصطفی رجبی** · 2017/04/10, 10:56

نوشته اصلی توسط Arashman

سلام میخواستم ببنیم امکانش هست که مثلا یک فایل اکسل که همیشه روی یک سیستم Run هستش مثلا هر 2 ساعت یکبار به صورت خودکار ذخیره بشه(با استفاده از VBA)؟؟

سلام.برای این منظور به آدرس option/save/save Autorecover informationevry .... minبرو و زمان هر بار ذخیره روتعیین کن ولی بیشترین زمانی که میشه تعیین کرد هر 2 ساعت یکباراست.

**iranweld** · 2017/04/10, 11:27

با سلام

از طریق ماکرو امکان پذیر است.

در فایل پیوست دو زمان 10:20 و 12:20 برای ذخیره فایل تعریف شده است

فایل های پیوست شده

Book1.zip (11.9 کیلو بایت, مشاهدات 21)

**ali.b** · 2017/04/12, 12:30

کد:

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

**Arashman** · 2017/04/12, 12:50

نوشته اصلی توسط ali.b

کد:

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

متشکر از micro کاش به جایی بو میتونستم برم مایکرو نویسی یاد بگیرم