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

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

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

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

SiteAdmin

انضم إلى المنتدى ، فالأمر سريع وسهل

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

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

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

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

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

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

اذهب الى الأسفل

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

مُساهمة من طرف 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


SiteAdmin
SiteAdmin
Admin
Admin

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

http://ahlakalam.to-relax.net

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

الرجوع الى أعلى الصفحة


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