ขอโค้ดสำหรับ ดาวโหลดไฟล์แนบ

[UnKnown]

คุณ ปอนด์ Original post
รบกวนอาจารย์ทุกท่านค่ะ

ขอโค้ดสำหรับดาวโหลดเอกสารไฟล์แนบจากฐานข้อมูล attachments  คะ



ตามรูป เวลาเราจะบันทึก จะต้อง ดับเบิลคลิกที่ไฟล์แนบ แล้วจะขึ้นเอกสารมาให้เราเลือก Save  อีกที

แต่ต้องการสร้างปุ่มสำหรับการดาวโหลดขอมูลไฟล์แนบโดยเฉพาะ โดยไม่ต้องดับเบิลคลิกที่ไฟล์ ให้คลิกที่ปุ่มเพียงอย่างเดียวก็สามารถ ดาวโหลดข้อมูลทั้งหมดบันทึกลงเครื่องได้

พอจะมีโค้ดมั้ยค่ะ

ขอบคุณคะ   

[TTT]

ใช้โค้ดประมาณนี้ในการเซฟไฟล์ครับ แทนค่าตัวสีแดงให้ถูก
On Error GoTo Err_SaveImage
    Dim db As DAO.Database
    Dim rsParent As DAO.Recordset2
    Dim rsChild As DAO.Recordset2
    Set db = CurrentDb
    Set rs = Me.Recordset ' หรือหากฟอร์มไม่ได้ผูกกับฐานข้อมูล Set rsParent = db.OpenRecordset("ชื่อตาราง", dbOpenDynaset)
     rsParent.FindFirst "[ID] = " & Me.txt_ID ' txt_ID คือชื่อ TextBox ที่เป็น ID
'    rsParent.FindFirst "[ProductName] Like '*A*' AND [Quantity] = 15" ' หรือหากต้องการอ้างเรคคอร์ดที่เงื่อนไขอื่นๆ
    Set rsChild = rsParent.Fields("ชื่อฟิลด์ Attachment").Value
    While Not rsChild.EOF
        rsChild.Fields("FileData").SaveToFile "C:\Backup" 'พาธโฟลเดอร์ที่ต้องการเซฟไฟล์
        rsChild.MoveNext
    Wend
Exit_SaveImage:
    Set rsChild = Nothing
    Set rsParent = Nothing
    Exit Sub
Err_SaveImage:
    If Err.Number = 3839 Then
        MsgBox ("File Already Exists in the Directory!")
        Resume Next
    Else
        MsgBox "Some Other Error occured!", Err.Number, Err.Description
        Resume Exit_SaveImage
    End If

ปล. หากอยากเลือกโฟลเดอร์เองด้วยก็ต้องเขียนโค้ดเปิด Dialog Box เลือกโฟลเดอร์เพิ่มเติมอีก ปรับใช้ดูครับ

[UnKnown]

คุณ ปอนด์ Original post
ขอบคุณ อาจารย์ TTT  มากๆ เลยนะคะ

[UnKnown]

คุณ ปอนด์ Original post
รบกวน อีก 1 เรื่องค่ะ อาจารย์ TTT  ถ้าเราต้องการ Copy Record ทั้ง Record โดยมีไฟล์แนบของ Record  ที่ เรา Copy ติดมาด้วย ต้องทำอย่างไรค่ะ
ตอนนี้ใช้ โค้ด นี้ ในการ Copy อยู่ค่ะ

On Error Resume Next
    DoCmd.RunCommand acCmdSelectRecord
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdCopy
    End If
    If (MacroError = 0) Then
'        .AddNew
        DoCmd.RunCommand acCmdRecordsGoToNew
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdSelectRecord
    End If
    If (MacroError = 0) Then
        'DoCmd.RunCommand acCmdPaste
         
 

       End If
       
    If (MacroError <> 0) Then
        Beep
        MsgBox MacroError.Description, vbOKOnly, ""
   DoCmd.GoToRecord , , acLast
 
    End If
  DoCmd.GoToRecord , , acLast
  DoCmd.GoToControl "CNC"


แต่ปัญหาคือ จะมาเฉพาะข้อมูลที่เป็น Text ส่วน ตัว ไฟล์แนบไม่ติดมาด้วย

รบกวนอาจารย์ด้วนะคะ

[TTT]

อื่ม! ห้ามถึงต้องก๊อปปี้เรคคอร์ดที่กำลังโฟกัสอยู่ สำเนาไปเป็นเรคคอร์ดใหม่อีกเรคคอร์ดอย่างนั้นใช่ไม๊ครับ
ลองดูโค้ดแล้ว ใช้ได้นะครับ ใช้การเรียก Command menu แบบที่ใช้ก็ใช้ได้นะครับ ลองใส่แบบนี้ดูครับ

โค๊ด: [Select]

    DoCmd.RunCommand acCmdSelectRecord
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdCopy
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdRecordsGoToNew
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdSelectRecord
    End If
    If (MacroError = 0) Then
        DoCmd.RunCommand acCmdPaste
    End If
    If (MacroError <> 0) Then
        Beep
        MsgBox MacroError.Description, vbOKOnly, ""
        DoCmd.GoToRecord , , acLast
    End If
    DoCmd.GoToRecord , , acLast
    DoCmd.GoToControl "CNC"