أكاديمية الصقر للتدريب

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


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





معرفة ماذا يحتوي اي Folder تختاره مع الــ Sub_Folder

اذا كنت تريد من اكسل ان يدرج لك كل ملفات مجلد معين فقط اعطه عنوانه واضغظ الزر في هذا الملف [code]PGJyIC8+DQo8YnIgLz4N ..



18-08-2018 08:42 صباحا
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 

اذا كنت تريد من اكسل ان يدرج لك كل ملفات مجلد معين 
فقط اعطه عنوانه واضغظ الزر في هذا الملف
NDUxMzQyMQ9393Salim_Ex


Option Explicit

Sub ListFiles()
    Dim sPath As String
    Dim aFiles() As String
    Dim lFileCnt As Long
    sPath = Cells(1, 1)
    '===========================
    If Len(Dir(sPath, vbDirectory)) = 0 Then
        MsgBox "No such folder exists!", vbExclamation
        Exit Sub
    End If
       Range("a4").CurrentRegion.ClearContents
    On Error GoTo ErrHandler
     Call GeT_Dirs(sPath, aFiles, lFileCnt)
       
    If lFileCnt > 0 Then
        Range("A5:C5").Value = Array("File's Name", "Size(Kb)", "Created / Modified")
        Columns("B").NumberFormat = "#,##0.00"
        Columns("C").NumberFormat = "d/m/yy h:mm AM/PM"
        Range("A6").Resize(UBound(aFiles, 2), UBound(aFiles, 1)).Value = Application.Transpose(aFiles)
        Columns("A:C").AutoFit
    Else
        MsgBox "No files found!", vbExclamation
    End If
    
ExitSub:
    Exit Sub
       
ErrHandler:
    MsgBox "Error " & Err.Number & ":  " & Err.Description
    Resume ExitSub

End Sub

Sub GeT_Dirs(ByVal sCurrDir As String, ByRef aFiles() As String, ByRef lFileCnt As Long)

    'Declare the variables
    Dim sFileName As String
    Dim sPathAndName As String
    Dim aDirs() As String
    Dim lDirCnt As Long
    Dim i As Long
    
    'Make sure the path to the current folder ends with a backslash
    If Right(sCurrDir, 1) <> "" Then
        sCurrDir = sCurrDir & ""
    End If
    
    'Get the files
    sFileName = Dir(sCurrDir & "*.*", vbDirectory)
    While Len(sFileName) > 0
        If Left(sFileName, 1) <> "." Then
            sPathAndName = sCurrDir & sFileName
            If (GetAttr(sPathAndName) And vbDirectory) = vbDirectory Then
                'Store found folders in array
                lDirCnt = lDirCnt + 1
                ReDim Preserve aDirs(1 To lDirCnt)
                aDirs(lDirCnt) = sPathAndName
            Else
                'Store found files in array
                lFileCnt = lFileCnt + 1
                ReDim Preserve aFiles(1 To 3, 1 To lFileCnt)
                aFiles(1, lFileCnt) = sFileName
                aFiles(2, lFileCnt) = FileLen(sPathAndName) / 1000
                aFiles(3, lFileCnt) = FileDateTime(sPathAndName)
            End If
        End If
        sFileName = Dir
    Wend
    
    'Process the found folders, recursively
    For i = 1 To lDirCnt
        Call GeT_Dirs(aDirs(i), aFiles, lFileCnt)
    Next i
    
End Sub

Private Sub CommandButton1_Click()
ListFiles
End Sub
 
 
  Liste_Files.rar   تحميل rar مرات التحميل :(24)
الحجم :(24.4) KB


18-08-2018 11:39 صباحا
مشاهدة مشاركة منفردة [1]
ali mohamed ali
مشرف على منتدى الاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1766
الدولة : مصر
الجنس : ذكر
الدعوات : 2
يتابعهم : 0
يتابعونه : 68
قوة السمعة : 9632
عدد الإجابات: 46
 offline 
look/images/icons/i1.gif معرفة ماذا يحتوي اي Folder تختاره مع الــ Sub_Folder
أحسنت استاذ سليم كود ممتاز بارك الله فيك وجعله فى ميزان حسناتك
توقيع :ali mohamed ali
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
 الاخرين لوجه الله وان تحتسب له اجر عند الله

18-08-2018 12:03 مساء
مشاهدة مشاركة منفردة [2]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif معرفة ماذا يحتوي اي Folder تختاره مع الــ Sub_Folder
بارك الله فيك أخي الحبيب الغالي سليم ومشكور على موضوعاتك المميزة
تقبل وافر تقديري واحترامي وكل عام وأنت بخير

19-08-2018 08:05 مساء
مشاهدة مشاركة منفردة [3]
Eslam Abdullah
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1580
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 5
يتابعهم : 0
يتابعونه : 89
قوة السمعة : 10845
موقعي : زيارة موقعي
عدد الإجابات: 6
 offline 
look/images/icons/i1.gif معرفة ماذا يحتوي اي Folder تختاره مع الــ Sub_Folder
جزاك الله خيرا أستاذ سليم
واصل بلا فواصل 142




الكلمات الدلالية
معرفة ، ماذا ، يحتوي ، Folder ، تختاره ، الــ ، Sub_Folder ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 06:02 صباحا