[حل شده] ساختن پوشه درون پوشه ای که محل بک آپ گیری فایل است

[yamahdi13601982]

با سلام و خسته نباشید
لطفا بفرمائید چطوری میتونم یه پوشه تو درایو D درست کنم که فایل اکسلم توی این پوشه ای که البته خوده اکسل میسازه یه پوشه ی دیگه با نام تاریخ روز بسازه و بعد بک آپم رو اونجا بندازه
یعنی یه همچین چیزی :
D:\Backup_mohammadrezaa\13940918

میخوام این مسیر قبل از ذخیره فایل توسط خوده اکسل ساخته بشه
با تشکر

[yamahdi13601982]

یعنی اینکه یه پوشه ای بنام 13940918 داخل یه پوشه ی دیگه بنام Backup_mohammadrezaa ساخته بشه که بتونم ذخیره رو توی اون پوشه ی تاریخ انجام بدم

[Ali Parsaei]

سلام،
پاسخ سوالتان تقريبا" يک همچين چيزي است:
مثلا" يک دگمه درست کرده و کد زير را به آن تخصيص دهيد، البته در کد زير نام پوشه به تاريخ انگليسي است:

Private Sub CommandButton1_Click()
MkDir "D:\Backup_mohammadrezaa\" & Date$    
ChDir "D:\Backup_mohammadrezaa\" & Date$    
ActiveWorkbook.SaveAs Filename:="D:\Backup_mohammadrezaa\" & Date$ & "\backup.xlsm", FileFormat _       
 :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub 

[yamahdi13601982]

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

[yamahdi13601982]

ببخشید-متاسفانه ارور میده اگه امکان داره یه فایل نمونه بذارید

[Ali Parsaei]

فقط يک بار در يک روز بک آپ مي گيريد دفعه دوم پيغام خطا مي دهد!
ضمنا" بايد حتما" در دايو d قبلا" پوشه: بک آپ - محمد رضا موجود باشد. شايد هم بهتر باشد که تاريخ را دستي موقع بک آپ گيري از شما سوال کند! سعي مي کنم يک فايل نمونه به اين طريق برايتان بگذارم.

[Ali Parsaei]

فايل پيوست شد، فقط توجه کنيد که کد به نحوي نوشته شده که وقتي دگمه را مي زنيد فايل اصلي save و بسته مي شود و بک آپ گرفته شده و ديگر شما در فايل بک آپ قرار مي گيريد،

[iranweld]

با سلام

با کسب اجازه از مهندس پارسا

میتوان دوباره فایل اصلی را فراخوانی نمود و فایل Backup را بست

فایل پیوست را در درایو D کپی نمایید. (حتما با نام MKDIR.XLS )

Sub test()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Len(Dir("D:\Backup_mohammadreza", vbDirectory)) = 0 Then
   MkDir "D:\Backup_mohammadreza"
   End If
   
   If Len(Dir("D:\Backup_mohammadreza\" & jToday, vbDirectory)) = 0 Then
   MkDir "D:\Backup_mohammadreza\" & jToday
   
End If

ActiveWorkbook.SaveAs Filename:="D:\Backup_mohammadreza\" & jToday & "\backup.xlsm", FileFormat _
 :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 
 MsgBox "OK"
 
  ChDir "d:\"
 
     Workbooks.Open Filename:="D:\MKDIR.xls"
    
    Windows("backup.xlsm").Activate

    ActiveWindow.Close

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub 

[yamahdi13601982]

با تشکر از لطف و توجهتون

[iranweld]

در فایل پیوست نیازی به کپی فایل اصلی در یک مسیر خاص نمیباشد

XX = ActiveWorkbook.FullName


Workbooks.Open Filename:=XX