تعديل على كود نسخ الملفات (معدل)

[figo82eg]

ارجو المساعدة فى تعديل أحد الأكواد التى أحاول إستخدامها :

عند وضعها فى حدث ضغط على زر تظهر الرسالة التاليه

Dim rs As DAO.Recordset
Dim fso
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Set rs = CurrentDb.OpenRecordset("SELECT crn FROM BASIC_DATE")
If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst
    Do Until rs.EOF = True

       
sSourceFile = Application.CurrentProject.Path & "\CONTACT\" & rs!crn & ".pdf"
sDestinationFile = Application.CurrentProject.Path & "\CONTACT\old\"
fso.CopyFile sSourceFile, sDestinationFile, True
fso.DeleteFile sSourceFile
rs.MoveNext
    Loop
End If

تم تعديل يناير 25, 2021 بواسطه أبو إبراهيم الغامدي
تحسين مظهر الكود من أجل القراءة

[أبو إبراهيم الغامدي]

أهلا بك..

5 ساعات مضت, figo82eg said:

ارجو المساعدة فى تعديل أحد الأكواد التى أحاول إستخدامها :

عند وضعها فى حدث ضغط على زر تظهر الرسالة التاليه

أنت بحاجة إلى التحقق من كون الملف موجود قبل إجراء عملية النسخ بهذه الطريقة...

Sub CopyFile()
    Dim rs As DAO.Recordset
    Dim fso, sSourceFile, sDestinationFile
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rs = CurrentDb.OpenRecordset("SELECT crn FROM BASIC_DATE")
    If rs.RecordCount = 0 Then
        Exit Sub
    End If
     rs.MoveFirst
    Do Until rs.EOF 
        sSourceFile = Application.CurrentProject.Path & "\CONTACT\" & rs!crn & ".pdf"
        sDestinationFile = Application.CurrentProject.Path & "\CONTACT\old\"
        '-- تحقق من أن الملف موجود قبل إجراء عملية النسخ
        If fso.FileExists(sSourceFile) Then
            fso.CopyFile sSourceFile, sDestinationFile, True
            fso.DeleteFile sSourceFile
        End If
        rs.MoveNext
       Loop
End Sub

 

[figo82eg]

اشكرك اخى ابو ابراهيم على ردك واعذرنى لتأخرى فى الرد على مشاركتك نظرا لضعف النت لدى

 الكود السابق أتم حل جزء الأول من مشكلتى جزاك الله عنى خيراَ

    ولكن فى حالة وجود ملف بنفس الإسم فى الفولدر المنقول اليه يتم حذف الملف الموجود هل فى امكانية لنقل الملف مع وضع إسم أخر له

مثال : الملف المراد نقله أسمه 1 اريد عند وجود ملف بنفس الإسم فى فولدر أولد يتم تمسته 1_1

وعند وجود ملف إسمه 1_1 يتم تمسه الملف المنقول الجديد 1_2 وهكذا

تم تعديل يناير 26, 2021 بواسطه figo82eg

[figo82eg]

ارجو المساعدة من الأعضاء الكرام