كود لنسخ ملفات pdf من فولدر يحتوى على عدة فولدرات

[abdelfattahbadawy]

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

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

Sub MovePDFsToAnotherFolder()
Dim FSO As Object, sourcePath As String, destPath As String
Dim Fldr As Object, f As Object, ct As Long
sourcePath = "C:\Users\Administrator\Downloads\nnnn\"  'Change path and folder name to suit
destPath = "C:\Users\Administrator\Downloads\mmm\"  'Change path and folder name to suit
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.GetFolder(sourcePath).Files
For Each f In Fldr
    If f.Name Like "*.pdf*" Or f.Name Like "*PDF*" Then
        ct = ct + 1
        f.Move destPath
    End If
Next f
If ct > 0 Then
    MsgBox ct & " pdf files have been moved"
Else
    MsgBox "No pdf files found in the source folder"
End If
End Sub

 

مرفق صورة للتوضيح

[حسونة حسين]

صلوا على النبي يا حبايب مش تزعلوا نفسكم

هذه صورة توضح مكان الايقونة

اخى @abdelfattahbadawy يتم كتابه الكود بعد الضغط الايقونه ليكون شكل الكود جميل وحلو ليسهل على الاساتذه المساعده

اخى @عبدالفتاح في بي اكسيل 

1 ساعه مضت, عبدالفتاح في بي اكسيل said:

50  مشاركة   ولا  تعلم  كيف  ترفق الكود  من  خلال ايقونة  المنتدى  عندما  تضيف  تعليقك !!!

ال ٥٠ مشاركه لم يكن بها غير عدد ٣ مشاركات وضع اخى @abdelfattahbadawy فيها كود 

نلتمس العذر لانفسنا اخوتى

[عبدالفتاح في بي اكسيل]

@hassona229

شكرا  على  مرورك 

اعتذاري  على  قرائتي  الخاطئة لعدد المشاركات😱

فقط  من  باب  النصيحة  اردت  ان  ينظم  كوده  حتى  يساعده  بقية  الاعضاء 

عن  نفسي  انا  لا استطيع  قراءة  الكود  بهذه  الطريقة .

[عبدالفتاح في بي اكسيل]

@abdelfattahbadawy

جرب هذا الماكرو

Dim ct As Long, destPath As String

Sub MOVE_FILES()

Dim Fso As Object, Fldr  As Object, f As Object ', ct As Long
Dim sourcePath
Dim FileInFolder As Object

sourcePath = "C:\Users\Administrator\Downloads\nnnn\"  'Change path and folder name to suit
destPath = "C:\Users\Administrator\Downloads\mmm\"  'Change path and folder name to suit
Set Fso = CreateObject("Scripting.FileSystemObject")


LoopFolder (sourcePath)

Set Fldr = Fso.GetFolder(sourcePath)

For Each f In Fldr.subfolders
    LoopFolder (f)
Next f

If ct > 0 Then
    MsgBox ct & " pdf files have been moved"
Else
    MsgBox "No pdf files found in the source folder"
End If
End Sub


Private Function LoopFolder(AFolder)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set ThisFolder = Fso.GetFolder(AFolder)

    For Each FileInFolder In ThisFolder.Files
    If FileInFolder.Name Like "*.pdf*" Or FileInFolder.Name Like "*PDF*" Then
        ct = ct + 1
        FileInFolder.Move destPath
    End If
Next FileInFolder

End Function

 

[حسونة حسين]

لا داعى ابدا للاعتذار اخى @عبدالفتاح في بي اكسيل فكلنا هنا نساعد بعضنا حتى نرتقي بانفسنا بالتعلم وبالمنتدى بمزيد من الارتقاء والتقدم لينفع اخواننا من بعدنا

[abdelfattahbadawy]

مشكور أخى حسونة على التوضيح فالغريب أعمى ولو كان بصيراً.

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