خزن نسخة من الـ Attachment

[ام ناصر]

السلام عليكم ورحمة ..

اساتذتي الكرام لدي استفسار عن كيفية نقل المرفقات من  Attachment  الى  Attachment  آخر في نفس واجهة النموذج علماً ان استخدام swap لم تعطي النتائج المطلوبة .

 

 

نقل نسخة.rar

[jjafferr]

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

 

اختي ، انا لست من مشجعي حفظ المرفق في الجدول ، لذلك لا املك خبرة كافية في هذا الموضوع ،

لذا ، بحثت ووجدت مثال ، وقمت بتعديل المثال ليناسب مع طلبك

 

الكود التالي به وحدتان نمطيتان:

الاولى: CopyAttachment (الوحدة النمطية الاصلية) ، لعمل نسخة من المرفق الى حقل في سجل جديد آخر ، وهكذا يستعمل:

ومثلا نريد نسخ المرفق في الحقل fld_1 في الجدول tbl_1 ، من السجل الذي Emp=25 (هذا الحقل غير الزامي ، فيمكن تجاهله وتركه فارغا) ،  الى الحقل fld_2 في tbl_2 ،

call CopyAttachment("tbl_1", "fld_1", _
                    "tbl_2", "fld_2", _
                    "Emp=25")

.

الثانية: UpdateAttachment (الوحدة النمطية التي عدلت عليها) ، لتحديث حقل موجود اصلا ، ووهكذا يستعمل:

ومثلا نريد نسخ المرفق في الحقل fld_1 في الجدول tbl_1 ، من السجل الذي Emp=25 ، وتحديث الحقل fld_2 في tbl_2 ، الى السجل الذي Emp=30 "

call UpdateAttachment("tbl_1", "fld_1", _
                      "tbl_2", "fld_2", _
                      "Emp=25", "Emp=30")

.

والوحدتان النمطيتان هما:

Option Compare Database

'from
'http://www.access-programmers.co.uk/forums/showpost.php?p=1465813&postcount=3
'

Public Sub CopyAttachment(ByVal strTableSource As String, _
                            ByVal strSourceAttachmentField As String, _
                            ByVal strTableTarget As String, _
                            ByVal strTargetAttachmentField As String, _
                            Optional ByVal strCondition As String = "")
    Dim rstFrom As DAO.Recordset2
    Dim rstTo As DAO.Recordset2
    Dim rstMVF As DAO.Recordset2
    Dim rstMVT As DAO.Recordset2
    Dim strSQL As String
    Dim db As DAO.Database
    
    strSQL = "SELECT * FROM " & strTableSource
    Set db = CurrentDb
    If strCondition <> "" Then
        strSQL = strSQL & " WHERE " & strCondition
    End If
    Set rstFrom = db.OpenRecordset(strSQL, dbOpenDynaset)
    Set rstTo = db.OpenRecordset(strTableTarget, dbOpenDynaset)
    
    Do While rstFrom.EOF = False
        rstTo.AddNew
        'rstTo!Description = rstFrom![Description]
        Set rstMVF = rstFrom(strSourceAttachmentField).Value
        Set rstMVT = rstTo(strTargetAttachmentField).Value
        ' Copy all the attachment in the field (attachment datatype)
        Do While rstMVF.EOF = False
            rstMVT.AddNew
            rstMVT!FileData = rstMVF!FileData
            rstMVT!FileName = rstMVF!FileName
            '*********************************
            ' below fields are not updateable
            '
            'rstMVT!FileFlags = rstMVF!FileFlags
            'rstMVT!FileTimeStamp = rstMVF!FileTimeStamp
            'rstMVT!FileType = rstMVF!FileType
            'rstMVT!FileURL = rstMVF!FileURL
            '
            '*********************************
            rstMVT.Update
            rstMVF.MoveNext
        Loop
        rstMVF.Close
        rstMVT.Close
        Set rstMVF = Nothing
        Set rstMVT = Nothing
        rstTo.Update
        rstFrom.MoveNext
    Loop
    rstFrom.Close
    rstTo.Close
    Set rstFrom = Nothing
    Set rstTo = Nothing
    Set db = Nothing
End Sub

'
'modified by jjafferr to include a condition for both source and destination tables
'04-01-2017
'
Public Sub UpdateAttachment(ByVal strTableSource As String, _
                            ByVal strSourceAttachmentField As String, _
                            ByVal strTableTarget As String, _
                            ByVal strTargetAttachmentField As String, _
                            ByVal strCondition_s As String, _
                            ByVal strCondition_d As String)
    Dim rstFrom As DAO.Recordset2
    Dim rstTo As DAO.Recordset2
    Dim rstMVF As DAO.Recordset2
    Dim rstMVT As DAO.Recordset2
    Dim strSQL_Source As String
    Dim strSQL_destination As String
    Dim db As DAO.Database
    
    strSQL_Source = "SELECT * FROM " & strTableSource
    strSQL_destination = "SELECT * FROM " & strTableTarget
    
    Set db = CurrentDb
    'If strCondition <> "" Then
        strSQL_Source = strSQL_Source & " WHERE " & strCondition_s
        strSQL_destination = strSQL_destination & " WHERE " & strCondition_d
    'End If
    Set rstFrom = db.OpenRecordset(strSQL_Source, dbOpenDynaset)
    Set rstTo = db.OpenRecordset(strSQL_destination, dbOpenDynaset)
    
    Do While rstFrom.EOF = False
        rstTo.Edit
        'rstTo!Description = rstFrom![Description]
        Set rstMVF = rstFrom(strSourceAttachmentField).Value
        Set rstMVT = rstTo(strTargetAttachmentField).Value
        ' Copy all the attachment in the field (attachment datatype)
        Do While rstMVF.EOF = False
            rstMVT.AddNew
            rstMVT!FileData = rstMVF!FileData
            rstMVT!FileName = rstMVF!FileName
            '*********************************
            ' below fields are not updateable
            '
            'rstMVT!FileFlags = rstMVF!FileFlags
            'rstMVT!FileTimeStamp = rstMVF!FileTimeStamp
            'rstMVT!FileType = rstMVF!FileType
            'rstMVT!FileURL = rstMVF!FileURL
            '
            '*********************************
            rstMVT.Update
            rstMVF.MoveNext
        Loop
        rstMVF.Close
        rstMVT.Close
        Set rstMVF = Nothing
        Set rstMVT = Nothing
        rstTo.Update
        rstFrom.MoveNext
    Loop
    rstFrom.Close
    rstTo.Close
    Set rstFrom = Nothing
    Set rstTo = Nothing
    Set db = Nothing
End Sub

.

جعفر

522.نقل نسخة.accdb.zip

[ام ناصر]

جزيل الشكر لحضرتك استاذ جعفر كفيت ووفيت بالشرح وفي ايصالي للنتيجة المطلوبة .. جزاك ربنا  خير الجزاء