نویسنده موضوع: مشکل در کد بکاپ روزانه  (دفعات بازدید: 312 بار)

bagheri65

  • کاربر انجمن
  • **
  • ارسال: 60
  • جمع امتیازها: +0/-0
مشکل در کد بکاپ روزانه
« : 25 فروردین 1400 - 10:47:03 »
سلام دوستان
این کد بکاپ هیچ مشکلی نداره
فقط میخوام تغییر مسیر بدم به درایو(D) قبول نمیکنه
لطفا راهنمایی کنید
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, " yyyy_mm_dd ")) & ".xls"
End Sub


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

d349

  • کاربر فعال
  • ***
  • ارسال: 186
  • جمع امتیازها: +6/-0
پاسخ : مشکل در کد بکاپ روزانه
« پاسخ #1 : 26 فروردین 1400 - 23:52:53 »
باسلام
فایل پیوست را بررسی کنید
سپاس

bagheri65

  • کاربر انجمن
  • **
  • ارسال: 60
  • جمع امتیازها: +0/-0
پاسخ : مشکل در کد بکاپ روزانه
« پاسخ #2 : 6 اردیبهشت 1400 - 10:00:15 »
ممنون تو فایل مشکلی نیست ولی زیادی پیچیده شده
همون کد ارسال شده عملیات رو انجام میده
ولی میخوام از داکیونت به درایو انتقال پیدا کنه
لطفا راهنمایی کنید

d349

  • کاربر فعال
  • ***
  • ارسال: 186
  • جمع امتیازها: +6/-0
پاسخ : مشکل در کد بکاپ روزانه
« پاسخ #3 : 7 اردیبهشت 1400 - 00:28:14 »
باسلام
به نظربنده اگر می خواهید در درایو دیگری پشتیبان ایجاد بشه ابتدا بصورت دستی یک پوشه ایجاد کنید وبعد مسیر پوشه را در همون کد قبلی خودتان جایگزین کنید مانند D:\test