منتدى أحلـــى كـــلام
عزيزى الزائر

كونك زائر غير مسجل

* سيتم عرض اعلانات لك، هذه الاعلانات لا تظهر للاعظاء.
* لن تتمكن من مشاهدة بعض محتويات مواضيعنا.

ندعوك للتسجيل بأقل من دقيقة
* لتتمكن من مشاهدة كافة محتويات المواضيع التى ترغب فى قرآئتها .
* وقف عرض الاعلانات.

SiteAdmin

كود نسخ الملفات من فهرس " مجلد " الى آخر

استعرض الموضوع السابق استعرض الموضوع التالي اذهب الى الأسفل

كود نسخ الملفات من فهرس " مجلد " الى آخر

مُساهمة من طرف SiteAdmin في الثلاثاء يونيو 14, 2011 10:10 am

كود نسخ ملفات من فهرس( مجلد ) الى آخر


لاحظ :


1- تم وضع الكود فى Function ويجب تحديد الفهرس المراد النسخ منه والفهرس
المراد النسخ له وقمنا بافتراض ان المستخدم سيكتبهم فى
textbox ولكن يمكنك تغيير ذلك باى اسلوب
تراه مناسبا.



2- سيتحقق الكود من ان
كلا الفهرسين ينتهيان بالعلامة \ واذا لم يكونا
كذلك سيتم اضافتهما الى اسم الفهارس.



3- فى حالة الفهرس
المنسوخ له غير موجود سيتم انشاؤة .



4- اذا كان الفهرس
المنسوخ له موجود فعلا وبه نفس الملفات ، ماذا سيحدث ؟



جرب الكود بنفسك لتعرف
ماذا سيحدث






الكود:



Public Function Copy_Files_Folder(ByRef strFrom_Path As String, ByRef strTo_Path As String)


    'Copy all the files in a directory to another'


    Dim FSO As FileSystemObject


    Dim strFile As String 'Used to store the files that are found


    On Error GoTo err_hndl


    'Simple check if
the path is correct it hase to end with "" else is added


    If Right$(strFrom_Path, 1) <> "\" Then strFrom_Path = strFrom_Path & "\"


    If Right$(strTo_Path, 1) <> "\" Then strTo_Path = strTo_Path & "\"


    'find the files with the extension as *.* for all files in the current path


    strFile = Dir(strFrom_Path & "*.*")


    'list all the file till dir return empty string


    Do While Len(strFile)


        Set FSO = New
FileSystemObject


        With FSO


            'check if the new folder exist if not create new one


            If Not .FolderExists(strTo_Path) Then .CreateFolder (strTo_Path)


             
.CopyFile strFrom_Path & strFile, strTo_Path & strFile 'copy the files in the new directory


        End With


 


        Set FSO = Nothing


        strFile = Dir          'send the next file to variable File


    Loop


    Exit Function


err_hndl:


    MsgBox "Error in Copy_Files_Folder()" & vbCrLf & Err.Number & ": " & Err.Description, vbCritical


End Function


 


 


Private Sub Command1_Click()


    'test button click


    Call Copy_Files_Folder(txtForm_Path.Text, txtTo_Path.Text)


End Sub



_________________
Best Regards
Site Administrator
avatar
SiteAdmin
Admin
Admin

عدد المساهمات : 333
نقاط : 2040
تقييم العضو : 6
تاريخ التسجيل : 09/06/2010
العمر : 43
الموقع : Banker

http://ahlakalam.to-relax.net

الرجوع الى أعلى الصفحة اذهب الى الأسفل

استعرض الموضوع السابق استعرض الموضوع التالي الرجوع الى أعلى الصفحة


 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى