كود احضار اسماء الملفات

[ammarhowari]

الكود التالي  لاحضار اسماء الملفات   ممكن يصير تعديل عليه لاحضار اسماء المجلدات ؟  لو تكرمتم

Sub Example1()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
    Next
End Sub

 

 

 

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

مجرد  محاولة 

غير  هذه 

    For Each xFile In xFolder.Files

الى 

  For Each xFile In xFolder.subfolders

 

[ammarhowari]

تمام شكرا استاذي   لكن انا عايز الرابط تبع الملف  هوا يجيب اسم الملف ويلصقه كرابط 

 

[omar elhosseini]

احي شاهد المرفق

Link_Files_In_Folder_And_SubFoldr.xls

[ammarhowari]

السلام عليكم  تحياتي للجميع ورمضان مبارك ع الجميع الكود  يعمل  omar elhosseini  شكرا الك 

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