حذف الصور من ملف خارجي عند الاغلاق

[محمد التميمي]

السلام عليكم:

اخواني الكرام محتاج كود لحذف الصور بكافة الصيغ عند الاغلاق والتي تتكدس في فولدر خارجي باسم (QR_images) حسب المسار الاتي (  Data\QR_images) بزر الامر الموجود في النموذج .

مع فائق الشكر والتقدير 

New folder.rar

[kanory]

11 دقائق مضت, محمد التميمي said:

خواني الكرام محتاج كود لحذف الصور بكافة الصيغ عند الاغلاق والتي تتكدس في فولدر خارجي باسم (QR_images) حسب المسار الاتي (  Data\QR_images) بزر الامر الموجود في النموذج .

تفضل .....

Private Sub Command_Click()
Call DeleteImageFiles
DoCmd.Quit
End Sub
Sub DeleteImageFiles()
    Dim fso As Object
    Dim folderPath As String
    Dim file As Object
    
    ' تحديد مسار المجلد المطلوب
    folderPath = CurrentProject.Path & "\Data\QR_images\"
    
    ' التأكد من وجود المجلد
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "المجلد غير موجود: " & folderPath, vbExclamation, "خطأ"
        Exit Sub
    End If
    
    ' إنشاء كائن FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' التحقق من الملفات داخل المجلد
    For Each file In fso.GetFolder(folderPath).Files
        ' التحقق إذا كان الملف صورة (حسب الامتداد)
        If LCase(file.Name) Like "*.jpg" Or _
           LCase(file.Name) Like "*.jpeg" Or _
           LCase(file.Name) Like "*.png" Or _
           LCase(file.Name) Like "*.bmp" Or _
           LCase(file.Name) Like "*.gif" Then
            ' حذف الملف
            file.Delete True
        End If
    Next file
    
    MsgBox "تم حذف جميع ملفات الصور بنجاح!", vbInformation, "عملية ناجحة"
    
    ' تحرير الكائنات
    Set fso = Nothing
End Sub

 

[hanan_ms]

22 minutes ago, محمد التميمي said:

QR_images

كود:

 Dim FSO                               As Scripting.FileSystemObject

Set FSO = New Scripting.FileSystemObject
    
         On Error Resume Next
         '=================================( Delete Folder #Qr_IMGES ! What ! Opss No Delet Folder )
FSO.DeleteFolder CurrentProject.Path & "\Qr_IMGES"

الملف ما ينحذف انت اضفة من المكتبة اداة

Zint

خذها من اي عملية تثبيت غير قواعد الاكسس تسبب مشكلة لدى العميل 

 

لبعض العملاء يغفلون الحواسيب من يوزر الويندوز 

من سهولة فكه وارجاعة CMD 

يعتبر مخالفة غير مشروعه تأكد في كاميرات 😂

 

العميل محتاج قواعدة بمشروع ونظام آمن 

 

ما تقدر تثبته باجهزة العملاء الا اذا كان اجهزتهم غير مغفلة بيوز الويندوز كصلاحيات  

 

فستبدل بالخط فقط يكون جنب القاعدة يوجد مرفق  ☕

بالاشاره الى الملف ( كوي آر بار كود ) فريد ما ينحذف خصص له مكان واحد بالسنوات وتعدد رقمي 

 

[Foksh]

مشاركة سريعة .. جرب هذا الكود للزر

Private Sub Command_Click()
    Dim FolderPath As String
    Dim FileName As String
    Dim FileSystem As Object
    FolderPath = CurrentProject.Path & "\Data\QR_images\"
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    If FileSystem.FolderExists(FolderPath) Then
        FileName = Dir(FolderPath & "*.*")
        Do While FileName <> ""
            If FileSystem.FileExists(FolderPath & FileName) Then
                Kill FolderPath & FileName
            End If
            FileName = Dir()
        Loop
    Else
        MsgBox "المجلد غير موجود", vbExclamation, "خطأ"
    End If
    MsgBox "تم حذف جميع الصور بنجاح", vbInformation, "تم"
End Sub

Database.accdb

[محمد التميمي]

11 ساعات مضت, kanory said:

تفضل .....

Private Sub Command_Click()
Call DeleteImageFiles
DoCmd.Quit
End Sub
Sub DeleteImageFiles()
    Dim fso As Object
    Dim folderPath As String
    Dim file As Object
    
    ' تحديد مسار المجلد المطلوب
    folderPath = CurrentProject.Path & "\Data\QR_images\"
    
    ' التأكد من وجود المجلد
    If Dir(folderPath, vbDirectory) = "" Then
        MsgBox "المجلد غير موجود: " & folderPath, vbExclamation, "خطأ"
        Exit Sub
    End If
    
    ' إنشاء كائن FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' التحقق من الملفات داخل المجلد
    For Each file In fso.GetFolder(folderPath).Files
        ' التحقق إذا كان الملف صورة (حسب الامتداد)
        If LCase(file.Name) Like "*.jpg" Or _
           LCase(file.Name) Like "*.jpeg" Or _
           LCase(file.Name) Like "*.png" Or _
           LCase(file.Name) Like "*.bmp" Or _
           LCase(file.Name) Like "*.gif" Then
            ' حذف الملف
            file.Delete True
        End If
    Next file
    
    MsgBox "تم حذف جميع ملفات الصور بنجاح!", vbInformation, "عملية ناجحة"
    
    ' تحرير الكائنات
    Set fso = Nothing
End Sub

 

 

9 ساعات مضت, Foksh said:

مشاركة سريعة .. جرب هذا الكود للزر

Private Sub Command_Click()
    Dim FolderPath As String
    Dim FileName As String
    Dim FileSystem As Object
    FolderPath = CurrentProject.Path & "\Data\QR_images\"
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    If FileSystem.FolderExists(FolderPath) Then
        FileName = Dir(FolderPath & "*.*")
        Do While FileName <> ""
            If FileSystem.FileExists(FolderPath & FileName) Then
                Kill FolderPath & FileName
            End If
            FileName = Dir()
        Loop
    Else
        MsgBox "المجلد غير موجود", vbExclamation, "خطأ"
    End If
    MsgBox "تم حذف جميع الصور بنجاح", vbInformation, "تم"
End Sub

Database.accdb 604 kB · 3 downloads

السلام عليكم : بارك الله بجهودكم اساتذتي الكرام الاكواد تعمل بامتياز شكرا جزيلا لكم وجعله الله في ميزان حسناتكم انشاء الله . 

[محمد التميمي]

11 ساعات مضت, hanan_ms said:

كود:

 Dim FSO                               As Scripting.FileSystemObject

Set FSO = New Scripting.FileSystemObject
    
         On Error Resume Next
         '=================================( Delete Folder #Qr_IMGES ! What ! Opss No Delet Folder )
FSO.DeleteFolder CurrentProject.Path & "\Qr_IMGES"

الملف ما ينحذف انت اضفة من المكتبة اداة

Zint

خذها من اي عملية تثبيت غير قواعد الاكسس تسبب مشكلة لدى العميل 

 

لبعض العملاء يغفلون الحواسيب من يوزر الويندوز 

من سهولة فكه وارجاعة CMD 

يعتبر مخالفة غير مشروعه تأكد في كاميرات 😂

 

العميل محتاج قواعدة بمشروع ونظام آمن 

 

ما تقدر تثبته باجهزة العملاء الا اذا كان اجهزتهم غير مغفلة بيوز الويندوز كصلاحيات  

 

فستبدل بالخط فقط يكون جنب القاعدة يوجد مرفق  ☕

بالاشاره الى الملف ( كوي آر بار كود ) فريد ما ينحذف خصص له مكان واحد بالسنوات وتعدد رقمي 

 

السلام عليكم :

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

انا احتاج الية اثناء طباعة الهوية فقط ولا احتاج اليه ليحفض ويتكدس في الملف ويسبب تضخم في حجم ملفات الهويات.

مع فائق الشكر والاحترام