كيفية استخلاص صورة من كائن صورة

[طير البحر]

الاخوة الافاضل لديا فى الفورم كائن صورة به صورة غير منضمة فى جدول ولا مسار هل يمكن استخلاصها وحفظها على الجهاز 
مرفق المثال

saveimage.accdb

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

  

5 ساعات مضت, طير البحر said:

لديا فى الفورم كائن صورة به صورة غير منضمة فى جدول ولا مسار هل يمكن استخلاصها وحفظها على الجهاز

نعم ممكن اليك الكود 

Option Compare Database
Option Explicit

Private Sub Command2_Click()
    ExtractImage
End Sub

Public Sub ExtractImage()

    Dim Db As DAO.Database
    Dim Rs_p As DAO.Recordset2
    Dim Rs_c As DAO.Recordset2
    
    Dim sPath As String
    Dim sFile As String
    
    sPath = CurrentProject.Path & "\Images\"
    
    Set Db = CurrentDb
    
    Set Rs_p = Db.OpenRecordset("select * from MsysResources where [type]='img';", dbOpenDynaset)
    
    With Rs_p
        If Not (.BOF And .EOF) Then
            .MoveFirst
            MKDir sPath
      
            Do Until .EOF
                Set Rs_c = .Fields("Data").Value
                
                sFile = sPath & .Fields("Name") & "." & .Fields("Extension")
                If Len(Dir$(sFile)) <> 0 Then
                    Kill sFile
                End If
                
                Rs_c.Fields("FileData").SaveToFile sFile
            
                Set Rs_c = Nothing
                
                .MoveNext
            Loop
            MsgBox "    : تمت عملية إستخراج الصور الى   " & sPath, vbInformation, "تأكيد"
        End If
        .Close
    End With
    
    Set Rs_p = Nothing
    Set Db = Nothing
            
End Sub

Public Sub MKDir(ByVal sPath As String)
    Dim var As Variant, v As Variant
    Dim sPth As String
    
    var = Split(sPath, "\")
    
    On Error Resume Next
    
    For Each v In var
        sPth = sPth & v
        VBA.MKDir sPth
        sPth = sPth & "\"
    Next v

End Sub

سيتم إنشاء مجلد بجانب قاعدة البيانات باسم Images يمكنك تغير اسم المجلد كما تريد وسيتم استخراج كافة الصور و الايقونات من قاعدة البيانات وحفظها في المجلد.

وهذا ملفك مع الكود وتم إضافة ايقونات 2 للتجربة

بالتوفيق

saveimage2.accdb

[طير البحر]

الاخ @سامي الحداد جزاك الله خيرا 
الحقيقة عمل رائع ولكن حتى يستقر فهمي
المثال اخرج كل الصورحتى منهم صورة غيرظاهرة
ويبدو انها مضمنة فى جدول الكائنات

فهل لى ان اطمع فى تعديل بسيط على جزء الاستخراج فى الكود ليخرج صورة محددة بدلالة اسم الكائن 

وهل الامر يرجع لجملة الاستعلام هكذا

Set Rs_p = Db.OpenRecordset("SELECT * FROM MsysResources WHERE [type]='img' AND [Name]='Image1';", dbOpenDynaset) 

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

تم تعديل مارس 21 بواسطه طير البحر

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

نعم ممكن عملها كما عملت  وهذه طريقتي اليك التعديل 

Public Sub ExtractImage()
    Dim Db As DAO.Database
    Dim Rs_p As DAO.Recordset2
    Dim Rs_c As DAO.Recordset2

    Dim sPath As String
    Dim sFile As String
    Dim SpecificFileName As String

    SpecificFileName = "Image1"
    sPath = CurrentProject.Path & "\Images\"

    Set Db = CurrentDb

    Set Rs_p = Db.OpenRecordset("SELECT * FROM MsysResources WHERE [type]='img' AND [Name]='" & SpecificFileName & "';", dbOpenDynaset)

    With Rs_p
        If Not (.BOF And .EOF) Then
            .MoveFirst

            MKDir sPath

            Do Until .EOF
                Set Rs_c = .Fields("Data").Value

                sFile = sPath & .Fields("Name") & "." & .Fields("Extension")
                If Len(Dir$(sFile)) <> 0 Then
                    Kill sFile
                End If

                Rs_c.Fields("FileData").SaveToFile sFile

                Set Rs_c = Nothing

                .MoveNext
            Loop
            MsgBox "    : تمت عملية إستخراج الصور الى   " & sPath, vbInformation + vbMsgBoxRight, "تأكيد"
        End If
        .Close
    End With

    Set Rs_p = Nothing
    Set Db = Nothing

End Sub

Public Sub MKDir(ByVal sPath As String)
    Dim var As Variant, v As Variant
    Dim sPth As String

    var = Split(sPath, "\")

    On Error Resume Next

    For Each v In var
        sPth = sPth & v
        VBA.MKDir sPth
        sPth = sPth & "\"
    Next v

End Sub

بالتوفيق

[طير البحر]

31 minutes ago, سامي الحداد said:

نعم ممكن عملها كما عملت  وهذه طريقتي اليك التعديل 

Public Sub ExtractImage()
    Dim Db As DAO.Database
    Dim Rs_p As DAO.Recordset2
    Dim Rs_c As DAO.Recordset2

    Dim sPath As String
    Dim sFile As String
    Dim SpecificFileName As String

    SpecificFileName = "Image1"
    sPath = CurrentProject.Path & "\Images\"

    Set Db = CurrentDb

    Set Rs_p = Db.OpenRecordset("SELECT * FROM MsysResources WHERE [type]='img' AND [Name]='" & SpecificFileName & "';", dbOpenDynaset)

    With Rs_p
        If Not (.BOF And .EOF) Then
            .MoveFirst

            MKDir sPath

            Do Until .EOF
                Set Rs_c = .Fields("Data").Value

                sFile = sPath & .Fields("Name") & "." & .Fields("Extension")
                If Len(Dir$(sFile)) <> 0 Then
                    Kill sFile
                End If

                Rs_c.Fields("FileData").SaveToFile sFile

                Set Rs_c = Nothing

                .MoveNext
            Loop
            MsgBox "    : تمت عملية إستخراج الصور الى   " & sPath, vbInformation + vbMsgBoxRight, "تأكيد"
        End If
        .Close
    End With

    Set Rs_p = Nothing
    Set Db = Nothing

End Sub

Public Sub MKDir(ByVal sPath As String)
    Dim var As Variant, v As Variant
    Dim sPth As String

    var = Split(sPath, "\")

    On Error Resume Next

    For Each v In var
        sPth = sPth & v
        VBA.MKDir sPth
        sPth = sPth & "\"
    Next v

End Sub

بالتوفيق

اشكرك وبعد  بعض المحاولات فهمت انه يتستخرج من جاليري الصور الموضح فى الصورة المرفقة 
ولو تكرمت علينا جميعا بمقال خاص عن الجدولMsysResources وبنيته ومحتوياته 
نكون شاكرين
جزاكم الله خيرا لقد وصلت للمطلوب فى عملي
لكنى تواق للمزيد 
جزيتم عنا خير الجزاء