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

[ابوخليل]

السلام عليكم

المرفق ادناه يحتوي مثل ما في الصورة المعروضة

عند النقر على الزر يفتح مربع حوار اكسس ، وعند النقر على  Open يتم فتح المرفق

المطلوب :

لا اريد ظهور مربع حوار اكسس

اريد ان يتم فتح المرفق من الزر مباشرة 

DbTest.rar

[kanory]

22 دقائق مضت, ابوخليل said:

ند النقر على الزر يفتح مربع حوار اكسس ، وعند النقر على  Open يتم فتح المرفق

المطلوب :

لا اريد ظهور مربع حوار اكسس

اريد ان يتم فتح المرفق من الزر مباشرة 

وعليكم السلام اهلا بك استاذي القدير @ابوخليل

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

Private Sub cmdOpenAttachment_Click()

    Dim rs As DAO.Recordset2
    Dim rsA As DAO.Recordset2
    Dim fld As DAO.Field2
    Dim tmpPath As String
    Dim fileName As String

    'افتح السجل الحالي
    Set rs = Me.Recordset
    
    'اسم الحقل الذي يحتوي على المرفق
    Set fld = rs.Fields("MyAttachmentField")   '← غيّر الاسم حسب جدولك

    If fld.Value Is Nothing Then
        MsgBox "لا يوجد مرفق لفتحه.", vbExclamation
        Exit Sub
    End If

    'افتح المرفق داخل الحقل
    Set rsA = fld.Value

    If rsA.RecordCount = 0 Then
        MsgBox "لا يوجد مرفق.", vbExclamation
        Exit Sub
    End If

    rsA.MoveFirst

    'الاسم الأصلي للمرفق
    fileName = rsA.Fields("FileName").Value

    'حدد مسار مجلد مؤقت
    tmpPath = Environ("TEMP") & "\" & fileName

    'احفظ المرفق كملف مؤقت
    rsA.Fields("FileData").SaveToFile tmpPath

    'افتح الملف بالبرنامج الافتراضي
    FollowHyperlink tmpPath

End Sub

 

[Foksh]

متابع عن بعد 😊 

لأن ما يفعله آكسيس هو استخراج المرفق إلى مجلد Temp ثم فتحه باستخدام :-

FollowHyperlink filePath

 

[ابوخليل]

21 دقائق مضت, Foksh said:

متابع عن بعد 😊 

لأن ما يفعله آكسيس هو استخراج المرفق إلى مجلد Temp ثم فتحه باستخدام :-

 

يجب ان تتابع عن قرب

افتح مجلد التيمب بعد اظهار المجلدات المخفية واجعله مفتوحا من اجل تتأكد  عند الاجراء

انا اعتقد انه يستخدم جدولا مخفيا

[Foksh]

27 دقائق مضت, ابوخليل said:

انا اعتقد انه يستخدم جدولا مخفيا

اعتذر عن مقاطعتك ومخالفتك الرأي   .. فآكسيس يستخدم المسار التالي في مربع حوار المرفقات عند النقر على الزر Open

C:\Users\Foksh\AppData\Local\Microsoft\Windows\INetCache\ACC9BE9

المسار من جهازي الشخصي باستبدال اسم المستخدم Foksh في جهازك للتجربة

[Foksh]

طبعاً المجلد ACC9BE9 هو مجلد عشوائي

[Foksh]

انظر الصورة المرفقة للتأكد .

 

لذالك ، وتحقيقاً لنفس الفكرة من زر Open .. استخدمت الدالة التالية :-

Public Sub OpenAttachmentFile(ByVal RecordID As Long, Optional ByVal PKFieldName As String = "ID")
    Dim rs As DAO.Recordset
    Dim rst As DAO.Recordset2
    Dim filePath As String
    Dim cachePath As String
    Dim subFolder As String
    
    cachePath = Environ("LOCALAPPDATA") & "\Microsoft\Windows\INetCache\"
    
    Randomize
    subFolder = "ACC" & Int((9999 * Rnd) + 1)
    
    If Dir(cachePath & subFolder, vbDirectory) = "" Then
        MkDir cachePath & subFolder
    End If
    
    Set rs = CurrentDb.OpenRecordset("SELECT progIcon FROM tblEnDc WHERE " & PKFieldName & "=" & RecordID)
    Set rst = rs.Fields("progIcon").Value
    
    If Not rst.EOF Then
        filePath = cachePath & subFolder & "\" & rst.Fields("FileName").Value
        
        If Dir(filePath) = "" Then
            rst.Fields("FileData").SaveToFile filePath
        End If
        
        FollowHyperlink filePath
    End If
    
    rst.Close: Set rst = Nothing
    rs.Close: Set rs = Nothing
End Sub

واستدعيها حسب رقم السجل من خلال الزر كما يلي :-

Call OpenAttachmentFile(Me.ID)

 

طبعاً اسم المجلد عشوائي لمحاكاة نفس اسلوب آكسيس في السطر
 

subFolder = "ACC" & Int((9999 * Rnd) + 1)

 

[ابوخليل]

منذ ساعه, kanory said:

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

 

هذا الكود تم تداوله في موضوعنا السابق وكنت اريد تجاوز الوسيط

جزاك الله خيرا

اقتباس

لذالك ، وتحقيقاً لنفس الفكرة من زر Open .. استخدمت الدالة التالية :-

تمام  ارفع يدي استسلاما اخي فادي  .. وان ما تفضلت به عين الحقيقة

وهو الذي يقوم به اكسس

ايضا لاحظت بالتتبع انه يحذف المرفق بعد الاغلاق .. وهذا جيد .. سوف اطبقها

[Foksh]

كفكرة خطرت ببالي وقد حدثتها الى ما يلي :-

أن تكون الدالة عامة شاملة ويمكن استخدامها في أكثر من موضع أو جدول أو حقل أو سجل أو حتى عدد مرفقات . بحيث جعلتها تقبل استقبال اسم الجدول ، واسم حقل المرفقات ، واسم حقل لتحديد السجل ، ومربع النص = تحديد اي سجل ، ورقم المرفق لو كان الحقل متعدد المرفقات . 

فآكسيس يتعامل مع أول مرفق كقيمة تسلسلية = 0 ( كما هو الحال في الأعمدة داخل الكومبوبوكس مثلاً أو الليست بوكس ) . لذا حدّثتها لتكون بهذا الشكل :-

Public Sub OpenSpecificAttachment(ByVal TableName As String, _
                                  ByVal AttachmentField As String, _
                                  ByVal PKFieldName As String, _
                                  ByVal RecordID As Long, _
                                  Optional ByVal AttachmentIndex As Integer = 0)

    Dim rs As DAO.Recordset
    Dim rst As DAO.Recordset2
    Dim filePath As String
    Dim cachePath As String
    Dim subFolder As String
    
    cachePath = Environ("LOCALAPPDATA") & "\Microsoft\Windows\INetCache\"
    Randomize
    subFolder = "Foksh" & Int((9999 * Rnd) + 1)
    
    If Dir(cachePath & subFolder, vbDirectory) = "" Then
        MkDir cachePath & subFolder
        CreatedFolders.Add cachePath & subFolder
    End If
    
    Set rs = CurrentDb.OpenRecordset("SELECT " & AttachmentField & " FROM " & TableName & _
                                     " WHERE " & PKFieldName & "=" & RecordID)
    Set rst = rs.Fields(AttachmentField).Value
    
    If AttachmentIndex > 0 Then
        rst.Move AttachmentIndex
    Else
        rst.MoveFirst
    End If
    
    If Not rst.EOF Then
        filePath = cachePath & subFolder & "\" & rst.Fields("FileName").Value
        If Dir(filePath) = "" Then
            rst.Fields("FileData").SaveToFile filePath
        End If
        FollowHyperlink filePath
    End If
    
    rst.Close: Set rst = Nothing
    rs.Close: Set rs = Nothing
End Sub

بحيث تم تمرير باراميتر افتراضي القيمة للمرفق الأول لسهولة الإستدعاء ، حيث سيكون الإستدعاء متعدد الأشكال كما يلي :-

    Call OpenSpecificAttachment("tblEnDc", "progIcon", "ID", Me.ID)  'المرفق الأول أو الوحيد
    Call OpenSpecificAttachment("tblEnDc", "progIcon", "ID", Me.ID, 0)  ' المرفق الأول أو الوحيد أيضاً
    Call OpenSpecificAttachment("tblEnDc", "progIcon", "ID", Me.ID, 1)  ' المرفق الثاني اذا كان عدد المرفقات أكثر من واحد
    Call OpenSpecificAttachment("tblEnDc", "progIcon", "ID", Me.ID, 2)  ' المرفق الثالث اذا كان عدد المرفقات أكثر من واحد

 

 

وعند الخروج من النموذج ، ولحذف المجلد بشكل آمن ، قمت بجعل الدالة التي تفتح المرفق تقوم بتسجيل اسم المجلد الذي أنشأته في قائمة ( Collection ) . وعند إغلاق النموذج ، تمر على هذه القائمة فقط وتحذف المجلدات التي أنشأناها عند استعراض المرفقات فقط فذ هذا النموذج .

حيث تم تعريف المتغير التالي في أول المديول :-

Public CreatedFolders As New Collection

وإضافة الدالة التالية التي تقوم على حذف المجلد بما يحتويه :-

Public Sub SafeDeleteFolder(ByVal folderPath As String)
    Dim f As String
    On Error Resume Next
    
    f = Dir(folderPath & "\*.*", vbNormal)
    Do While f <> ""
        Kill folderPath & "\" & f
        f = Dir
    Loop
    
    RmDir folderPath
End Sub

وبالتالي عند إغلاق النموذج ، تم استخدام الكود التالي لتمرير الحذف للمجلدات :-

Private Sub Form_Close()
    Dim folderPath As Variant
    On Error Resume Next
    
    For Each folderPath In CreatedFolders
        Call SafeDeleteFolder(folderPath)
    Next
    
    Set CreatedFolders = Nothing
End Sub

 

ليصبح المرفق كالتالي كاملاً متكاملاً :-

DbTest.zip