بحث مخصص من جوجل فى أوفيسنا
Custom Search
|
البحث في الموقع
Showing results for tags 'كود النسخ الاحتياطي'.
تم العثور علي 1 نتيجه
-
مطلوب تعديل على كود النسخ الاحتياطي لكي يحفظ في الدي داخل مجلد السلام عليكم إخوتي أساتذتي أعضاء منتدى أفيسنا اريد تعديل مكان الحفظ الى الدي ويقوم بانشاء مجلد تلقائي باسم مجلد النسخ الاحتياطية ويحفظ الملفات كل واحد باسمه مع وقت وتاريخ الحفظ و العمل من الزميل الفاضل / عادل حنفى مرفق الملف جزاكم الله كل خير Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim strDate As String, DefPath As String Dim FileNameZip, FileNameXls Dim oApp As Object If ActiveWorkbook Is Nothing Then Exit Sub DefPath = ActiveWorkbook.Path If Len(DefPath) = 0 Then MsgBox "Plz Save activeworkbook before zipping" & Space(12), vbInformation, "zipping" Exit Sub End If If Right(DefPath, 1) <> "\" Then DefPath = DefPath & "\" End If strDate = Format(Now, " dd_mm_yyyy, hh.mm AMPM ") FileNameZip = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".zip" FileNameXls = DefPath & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & strDate & ".xls" If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then ActiveWorkbook.SaveCopyAs FileNameXls newzip (FileNameZip) Set oApp = CreateObject("Shell.Application") oApp.Namespace(FileNameZip).CopyHere FileNameXls On Error Resume Next Do Until oApp.Namespace(FileNameZip).items.Count = 1 Application.Wait (Now + TimeValue("0:00:01")) Loop On Error GoTo 0 Kill FileNameXls MsgBox "completed zipped : " & vbNewLine & FileNameZip, vbInformation, "zipping" Else MsgBox "FileNameZip or/and FileNameXls exist", vbInformation, "zipping" End If End Sub Private Sub newzip(sPath) If Len(Dir(sPath)) > 0 Then Kill sPath Open sPath For Output As #1 Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) Close #1 End Sub ابوعلي.rar