حذف الفولدرات المرتبطة بالنموذج فى حالة حذف السجل الخاص بها بنموذج ارشيف صادر ووارد

[figo82eg]

ارجو المساعدة ف حيث لدى مثال من استاذنا @Moosak يتم انشاء فولدرات للصور بناء على حقول بالنموذج يتم حفظ الصور بها وما اريده هو حذف الفولدرات المرتبطة بالنموذج فى حالة حذف السجل الخاص بها بنموذج ارشيف صادر ووارد

مرفق مثال

AttachFilesToDB.rar

[figo82eg]

للمساعدة

[figo82eg]

هل يوجد حل من اساتذة المنتدى

[Moosak]

عذرا أخي @figo82eg إنشغلنا بإجازة العيد 😅 ..

تفضل التعديل :

 

بعدها يتم حذف المجلد [ 1 ]  والخاص بالسجل رقم 1 بالكامل بما فيه من ملفات 🙂 

وهذا الكود المرتبط بزر الحذف :

Private Sub DltBtn_Click()

Dim DesPath As String
Dim D As String: D = "\"

DesPath = BECurrentPath & D & Me.InOut & D & Me.Department & D & Me.DocType & D & Me.ID

If IsFileExists(DesPath) = False Or IsBlank(Me.FileName) = True Then MsgBox "لا يمكن العثور على الملف", vbOKOnly, "": Exit Sub

On Error Resume Next
If MsgBox("هل حقا تريد حذف الملفات المرتبطة ؟", vbYesNo, "") = vbYes Then
DleteFolder DesPath
Me.FileName = ""
Me.ImageBox.Requery
End If
End Sub

وفي حدث عند الحذف للنموذج تضع هذا الأمر :

Private Sub Form_Delete(Cancel As Integer)
    DltBtn_Click
End Sub

مع الحاجة لإضافة هاتين الدالتين في موديول ( أنا أضفتها للموديول المسمى FilesHandlingModule  ) :

Public Function DleteFolder(FolderPath As String)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
fs.DeleteFolder FolderPath, True
Set fs = Nothing
End Function

'-----------------------------------------------------------------------------
' True if the argument is Nothing, Null, Empty, Missing or an empty string .
'-----------------------------------------------------------------------------
Public Function IsBlank(arg As Variant) As Boolean
    Select Case VarType(arg)
        Case vbEmpty
            IsBlank = True
        Case vbNull
            IsBlank = True
        Case vbString
            IsBlank = (LenB(arg) = 0)
        Case vbObject
            IsBlank = (arg Is Nothing)
        Case Else
            IsBlank = IsMissing(arg)
    End Select
End Function

 

 

AttachFilesToDB.rar

تم تعديل يوليو 11, 2022 بواسطه Moosak

[figo82eg]

جزاك الله عنا خير الجزاء استاذى الكريم @Moosakهذا هو المطلوب

[Moosak]

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

جزاك الله عنا خير الجزاء استاذى الكريم

اللهم آمين أخي العزيز وإياكم 😊🤲