حذف المجلد وجميع الملفات التي به (معدل)

[TQTHAMI]

السلام عليكم ورحمة الله وبركاتة

بوجد مرفق بحاجة الى تعدبل واضافة

عند الضغط على انشاء ياخذ اسم وموقع المجلد من الحفول المحددة

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

عند الضغط على فتح المجلد يفتح المجلد مع رسالة اذا لايوجد بة ملفات

 

حذف وانشاء مجلد .accdb

[jjafferr]

وعليكم السلام ورحمة الله وبركاته 🙂

 

تفضل يا سيدي ، دالة تحذف المجلد واللي فيه :

Function DelFolder(ByVal strDir As String) As Long
    On Error Resume Next
' to delete the directory and its contents

    Dim x As Long
    Dim intAttr As Integer
    Dim strAllDirs As String
    Dim strFile As String
    
    DelFolder = -1
    strDir = Trim$(strDir)
    
    If Len(strDir) = 0 Then Exit Function
    If right$(strDir, 1) = "\" Then strDir = Left$(strDir, Len(strDir) - 1)
    If InStr(strDir, "\") = 0 Then Exit Function
    
    intAttr = GetAttr(strDir)
    
    If (intAttr And vbDirectory) = 0 Then Exit Function
    strFile = Dir$(strDir & "\*.*", vbSystem Or vbDirectory Or vbHidden)
    
    Do While Len(strFile)
     If strFile <> "." And strFile <> ".." Then
        intAttr = GetAttr(strDir & "\" & strFile)
            If (intAttr And vbDirectory) Then
                strAllDirs = strAllDirs & strFile & Chr$(0)
            Else
                If intAttr <> vbNormal Then
                    SetAttr strDir & "\" & strFile, vbNormal
                    If Err Then DelFolder = Err: Exit Function
                End If
                Kill strDir & "\" & strFile
                If Err Then DelFolder = Err: Exit Function
            End If
     End If
     strFile = Dir$
    Loop
    
    Do While Len(strAllDirs)
        x = InStr(strAllDirs, Chr$(0))
        strFile = Left$(strAllDirs, x - 1)
        strAllDirs = Mid$(strAllDirs, x + 1)
        x = DelFolder(strDir & "\" & strFile)
    
        If x Then DelFolder = x: Exit Function
    Loop
    
    RmDir strDir
    
    If Err Then
        DelFolder = Err
    Else
        DelFolder = 0
    End If
    
End Function

 

جعفر

[kkhalifa1960]

تفضل أخي حصلت عندي هذا أنشاء وحذف مجلد ووافني بالرد

IMAGE (Khalifa).rar

[TQTHAMI]

هههههههههههههههه

السلام عليكم ورحمة الله وبركاتة

اضحك من الي خصل معي ابحث عن موضوعي ولم اجدة وتوقعت ان ادارة المنتدى حذفتة 

وبالصدفة الان وجدتة ومغير اسمه 

اخي جعفر  الدالة ممتازة لكن فية كود اصغر من هذي الدالة 

اخي kkhalifa1960

سوف اجرب مرفقك واوافيك بالنتيجه

 

 

[TQTHAMI]

اخي kkhalifa1960 جدا رائع لكن عند انشاء المجلد يظهر لي هذ تاحطاء

[kkhalifa1960]

أخي تأكد من المكتبات لديك لانه يعمل عندي ومافيه مشاكل 

[TQTHAMI]

الن

2 ساعات مضت, kkhalifa1960 said:

أخي تأكد من المكتبات لديك لانه يعمل عندي ومافيه مشاكل 

يسعد مساءك بالخير 

المكتيات موجودة وتم اصلاخ الخلل واعتقد انك تعمل على اوفس 14 

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

ولك جزيل الشكر

والشكر للاخ جعفر  ابو المقالب ((مداعبة))

🤣🤣

[kkhalifa1960]

 موفق لعون الله