نسخ ملف خارجي في مجلد خارجي

[wael_rafat]

السلام عليكم ورحمة الله وبركاته

الاخوة الافاضل مشرفي واعضاء منتدانا الكريم

سؤالي هو : طريقة نسخ ملف خارجي  بمجلد خارجي ( اي خارج قاعدة البيانات )    داخل جهاز الكمبيوتر

والغرض منه : هو عمل نسخة احتياطية  للجداول المرتبطة  بقاعدة البيانات في مجلد خارجي  داخل الكمبيوتر

ملخص الفكرة : هو عند الخروج من البرنامج يقوم الكود بنسخ  قاعدة الجداول المرتبطة  داخل مجلد خارجي  ( محدد داخل الكمبوتر )  مع التحديث والاحلال ( اي الغاء القديم ووضع الجديد ) بالتاريخ والوقت

مع خالص التقدير والحترام

[jjafferr]

وعليكم السلام أخي وائل 

 

اخذت لك هذا الكود من احد برامجي 

Private Sub Form_Close()
On Error GoTo err_Form_Close

    'make a backup of BE
    BE_or_FE = "C:"
    Backup_Folder = "D:"
    
    BE_Address = BE_or_FE & "\Haj_BE.accdb"
    BK_Address = Backup_Folder & "\Program\Haj_BE_" & Format(Now(), "yyyy-mm-dd_-hh-mm-ss") & ".accdb*"
    
    Call Shell("xcopy " & BE_Address & " " & BK_Address, vbHide)


Exit Sub
err_Form_Close:

    If Err.Number = 2450 Then
        'ignor
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If

End Sub

 

وهذا الكود لنسخ الملف وليس لحذف القديم ،

وفي هذا الرابط ستجد طريقة مشابهة لما تريد (اعذرني ، فوقتي لا يسمح لي بعمل المطلوب الان :( )

http://www.officena.net/ib/topic/61847-تعديل-على-كود-حفظ-مكان-الصورة/?do=findComment&comment=399928

 

جعفر

تم تعديل أغسطس 11, 2015 بواسطه jjafferr

[jjafferr]

السلام عليكم 

 

وهذه النسخة الكاملة للموضوع (البارحة بعد ان كتبت كل شئ ، اتضح ان المنتدى اُغلق للصيانة ، وراح كل الشغل )

 

 

2. عندما تستخدم البرنامج في شبكة بين مجموعة مستخدمين ، لا تريد البرنامج ان يعمل نسخة كلما خرج احد المستخدمين من البرنامج ، ولكن تريد ان يتم عمل النسخة عندما يخرج المستخدم الذي يعمل على الكمبيوتر jj فقط (طبعا يمكن استخدام اسم المستخدم بدلا من اسم الكمبيوتر):

if vba.Environ ("Computername")<> "jj" then Exit Sub

3. السطر التالي يحذف جميع الملفات القديمة لهذا الملف:

Kill Backup_Folder & "\Program\Haj_BE_*.accdb"

 

 

Private Sub Form_Close()
On Error GoTo err_Form_Close

    'make a backup of BE
    BE_or_FE = "C:"
    Backup_Folder = "D:"
    
    'Do a copy from a PC name jj ONLY
    if vba.Environ ("Computername")<> "jj" then Exit Sub
    
    'Delete the old saved accdb
    Kill Backup_Folder & "\Program\Haj_BE_*.accdb"
    
    'Now lets work on saving the new accdb''Is this PC name =  jj'
    '
    BE_Address = BE_or_FE & "\Haj_BE.accdb"
    BK_Address = Backup_Folder & "\Program\Haj_BE_" & Format(Now(), "yyyy-mm-dd_-hh-mm-ss") & ".accdb*"
    
    Call Shell("xcopy " & BE_Address & " " & BK_Address, vbHide)


Exit Sub
err_Form_Close:

    If Err.Number = 2450 or err.number=53 Then
        'ignor
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If

End Sub

 

جعفر

[محمد سلامة]

الله الله

مبدع استاذ جعفر

[jjafferr]

تسلم أخوي محمد 

 

نتيجة عمل برامج مختلفة ، لفئات مختلفة ، على فترات مختلفة ، بلغات مختلفة ، لسنوات عدة ، يسمونها خبرة 

ولولا اسئلة الشباب ، لما طلعت هذه الخبرة للملأ 

 

فالشكر موصول لكم ، لأسئلتكم ومداخلاتكم 

 

جعفر

 

[wael_rafat]

السلام عليكم

اخي واستاذي الكريم جعفر  .. اسف علي التأخير فى الرد وذلك لكون الموقع تحت الصيانة 

للاسف بعد التجربة لم اتمكن من الوصول للمطلوب ، ولا ادري من اين المشكلة 

المطلوب ببساطة : عند الضغط على ( EXIT ) بالقاعدة الاساسية  يقوم بعمل نسخة من  قاعدة الجداول المرتبطة ( AA_BE ) الي الفولدر ( back_folder  ) الموجود على الدرايف ( D ) مع التحديث ( اي الغاء النسخة القديمة ووضع الجديدة )  بكل مرة مع التاريخ والوقت 

مرفق القاعدتين ... وسامحني على الاطالة 

A.rar

[wael_rafat]

للرفع اخواني الكرام

[jjafferr]

وعليكم السلام أخي وائل 

 

انت كتبت اسم BE  بالخطأ  ، وعدلت انا الشئ البسيط على البرنامج كذلك ، فاليك الكود المعدل:

Private Sub Form_Close()
On Error GoTo err_Form_Close

    'make a backup of BE
    BE_or_FE = "C:\My Documents\Downloads\Officena.net\208.A"
    Backup_Folder = "C:\back_folder"
    
    'Do a copy from a PC name jj ONLY
    If VBA.Environ("Computername") <> "wael" Then Exit Sub
    
    'Delete the old saved accdb
    Kill Backup_Folder & "\AA_BE_*.accdb"
    
    'Now lets work on saving the new accdb''Is this PC name =  jj'
    '
    BE_Address = BE_or_FE & "\AA_BE.accdb"
    BK_Address = Backup_Folder & "\AA_BE_" & Format(Now(), "yyyy-mm-dd_-hh-mm-ss") & ".accdb*"
    
    'Debug.Print "xcopy " & Chr(34) & BE_Address & Chr(34) & " " & Chr(34) & BK_Address & Chr(34)
    Call Shell("xcopy " & Chr(34) & BE_Address & Chr(34) & " " & Chr(34) & BK_Address & Chr(34), vbHide)


Exit Sub
err_Form_Close:

    If Err.Number = 2450 Or Err.Number = 53 Then
        'ignor
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Sub

 

رجاء عدم تغيير الكود ، الإ السطرين التاليين فقط ، وهما لتحديد مسار BE ، وتحديد مسار back_folder 

جعفر

208.AA.mdb.zip

[wael_rafat]

استاذي الكريم جعفر  سامحني والله حاولت كتيييير  وللاسف ما نجحت مع العلم ان حددت مسار الBeوback_folder  علي الدرايف  D ، وانشاء الفولدر Back_folder  علي الدرايف D

برجاء تجربة الكود واسف مرة اخري علي الاطالة

تم تعديل أغسطس 19, 2015 بواسطه wael_rafat

[jjafferr]

ولا يهمك :-)

لوسمحت تكتب لي مسار BE

 

جعفر

[wael_rafat]

اتفضل اخي الكريم وبارك الله فيك

D:\prog\AA_BE.accdb

 

[jjafferr]

جرب هذا الكود

Private Sub Form_Close()
On Error GoTo err_Form_Close

    'make a backup of BE
    BE_or_FE = "D:\prog"
    Backup_Folder = "D:\back_folder"
    
    'Do a copy from a PC name jj ONLY
'    If VBA.Environ("Computername") <> "wael" Then Exit Sub
    
    'Delete the old saved accdb
    Kill Backup_Folder & "\AA_BE_*.accdb"
    
    'Now lets work on saving the new accdb''Is this PC name =  jj'
    '
    BE_Address = BE_or_FE & "\AA_BE.accdb"
    BK_Address = Backup_Folder & "\AA_BE_" & Format(Now(), "yyyy-mm-dd_hh-mm-ss") & ".accdb*"
    
    'Debug.Print "xcopy " & Chr(34) & BE_Address & Chr(34) & " " & Chr(34) & BK_Address & Chr(34)
    Call Shell("xcopy " & Chr(34) & BE_Address & Chr(34) & " " & Chr(34) & BK_Address & Chr(34), vbHide)


Exit Sub
err_Form_Close:

    If Err.Number = 2450 Or Err.Number = 53 Then
        'ignor
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Sub

انا انتظر جوابك بسرعة لوسمحت ، حتى نحصل على نتيجة قبل ان انام ان شاء الله 

 

جعفر

عفوا شئ آخر مهم:

 

الكود يشتغل اذا اغلقت النموذج ، ولا يشتغل اذا اغلقت البرنامج.

 

جعفر

[wael_rafat]

تسلم استاذي الغالي جعفر  جاري التجربة وساوافيك بالنتيجة غدا انشالله 

تصبح علي خير وصحة انشالله

[wael_rafat]

يا سلالالام عليك استاذنا   تماااام    بارك الله فيك وجزاك الله كل خير

وسامحني علي الاطالة  والف شكر علي الاهتمام والمتابعة

[jjafferr]

هلا والله 

[محمد سلامة]

برجاء متابعة هذا الموضوع استاذنا جعفر

http://www.officena.net/ib/topic/63756-نسخ-قاعدة-بيانات-الجداول-المرتبطة-فقط-عند-الخروج/