معرفة أسماء المجلدت الموجوده في مجلد معين

Public Function LoadPathFolders(strPath As String, Obj As Object, Optional ObjClear As Boolean = True)
On Error GoTo Handle:
Dim strFolder As String
Dim Attr As Integer
If ObjClear = True Then Obj.Clear
If Len(strPath) = 2 And Right(strPath, 1) <> "\" Then strPath = strPath + "\"
If Len(strPath) = 1 Then strPath = strPath + ":\"
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
strFolder = Dir(strPath, vbDirectory + vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem)
Do While strFolder <> ""
    If strFolder <> "." And strFolder <> ".." Then
        Attr = GetAttr(strPath & strFolder)
        If Attr = 16 Or Attr = 48 Or Attr = 18 Or Attr = 17 Or Attr = 22 Or Attr = 20 Or Attr = 19 Or Attr = 50 Or Attr = 49 Or Attr = 51 Then
            Obj.AddItem strFolder
        End If
    End If
    strFolder = Dir
Loop
Exit Function
Handle:
MsgBox Error, , App.Title
End Function

اظن ان هذه الوظيفة تفى بالغرض :rolleyes:

اولا اضف microsoft script run time من قائمة project->reference->microsoft script runtime ثم اكتب الكود التالي في زر الامر

dim fs as new filesystemobject
dim fold
dim subfold
dim folders
set fold=fs.getfolder(folderpath)
set subfold=fold.subfolders
for each folders in sufold
list1.additem folders.name
next

بحيث تضع مكان folderpath المسار الصحيح للمجلد الذي يحتوي على المجلدات الاخرى مثلا "c:\windows"

اخي GHOST2010 الف شكر لك على المساعده

وأرجو منك لو تكرمت التوضيح بمثال لأنه عند التطبيق يحصل عندي خطأ

أخي الكريم mostafazidani

وفقك الله وجزاك الف خير

قمت بتطبيق المثال لكن للأسف يحصل عندي الخطأ التالي

Run-time error 13

Type mismatch

اخي جرب هذا الكود بعد التعديل

لاتنسى ان تضيف لست بوكس طبعا

dim fs as new filesystemobject
dim fold
dim subfold
dim fo
set fold=fs.getfolder(folderpath)
set subfold=fold.subfolders
for each fo in subfold
list1.additem fo.name
next

جزاك الله الف خير أخي العزيز mostafazidani

الأن كل شي تمام 100%

شكرا لك

في الخدمة اخي امير البحر حيث كان الخطأ هو خطأ املائي فقط