none
excel vba to retreive/download attachment form accdb database with specific "ID No." RRS feed

  • Question

  • Hi is there anyone out there who could help me with my problem?
    below is the sample of the code which downloads "all" the attachments from my database. However, the problem is I would only like to download an attachment where ID No. = 1. Please help. thanks!

    Sub test()
        SaveAttachments "C:\Desktop\"
    End Sub

    Public Function SaveAttachments(strPath As String, Optional strPattern As String = "*.*") As Long
        Dim dbs As DAO.Database
        Dim rst As DAO.Recordset2
        Dim rsA As DAO.Recordset2
        Dim fld As DAO.Field2
        Dim strFullPath As String
       
        'Get the database, recordset, and attachment field
        Set dbs = OpenDatabase(Name:="S:\May Tracker.accdb")

        Set rst = dbs.OpenRecordset("Cash")
        Set fld = rst("Payment Details")
       
        'Navigate through the table
        Do While Not rst.EOF
       
            'Get the recordset for the Attachments field
            Set rsA = fld.Value
           
            'Save all attachments in the field
            Do While Not rsA.EOF
                If rsA("FileName") Like strPattern Then
                    strFullPath = strPath & "\" & rsA("FileName")
                   
                    'Make sure the file does not exist and save
                    If Dir(strFullPath) = "" Then
                        rsA("FileData").SaveToFile strFullPath
                    End If
                   
                    'Increment the number of files saved
                    SaveAttachments = SaveAttachments + 1
                End If
               
                'Next attachment
                rsA.MoveNext
            Loop
            rsA.Close
           
            'Next record
            rst.MoveNext
        Loop
       
        rst.Close
        dbs.Close
       
        Set fld = Nothing
        Set rsA = Nothing
        Set rst = Nothing
        Set dbs = Nothing
    End Function

    Friday, May 19, 2017 4:18 PM

Answers

  • Hi,

    When you say ID=1, are you referring to the ID value of the record or the attachment? In other words, are you asking how to extract the first attachment only? Or, are you asking how to extract all the attachments of only one record from the table?

    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:41 PM
    Friday, May 19, 2017 8:08 PM
  • Hi .theDBguy,

    Thanks for your reply. Yes, I am referring to the ID value of the record. I am asking how to extract all the attachments of only one record from the table, considering that if I will type ID No. = 1, it will extract all attachments in record with ID no. 1, I will type ID No. = 2 then it will extract  all attachments in record with ID no. 2 and so forth and so on. FYI.


    • Edited by Vlady Mhore Friday, May 19, 2017 8:56 PM
    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:41 PM
    Friday, May 19, 2017 8:56 PM
  • ciao Vlady,

    what about this, customizing all reference about exportation path and sql predicatoe ogf your scenario :

    Private Sub exportAttachments()
     On Error GoTo errHandler
     
        Dim rst             As dao.Recordset2
        Dim rstAttach       As dao.Recordset2
        Dim fldAttach       As dao.Field2
        Dim strSaveFullFile As String

        Const strSavepath As String = "c:\exporatatioPath\" ' to be customized"

        Set rst = DBEngine(0)(0).OpenRecordset("SELECT * FROM  yourTable WHERE IDPK = " & Me.IDPK, 4) 'dbforwardonly customze tableName and PkName
        Set fldAttach = rst!Attachments
        Set rstAttach = fldAttach.Value

        Do While Not rstAttach.EOF

            strSaveFullFile = strSavepath & "\" & rstAttach!FileName

            If FileExists(strSaveFullFile) Then Kill strSaveFullFile  ' be careful here, if the file exists routine will delete  it before saving   !!!!!
            rstAttach!FileData.SaveToFile strSaveFullFile
            rstAttach.MoveNext
        Loop
        VBA.MsgBox prompt:="Attachment Saved", _
                   buttons:=vbInformation, _
                   Title:="Information"        

    exitErrHandler:
        rstAttach.Close
        Set fldAttach = Nothing
        Set rstAttach = Nothing
        Exit Sub

    errHandler:
         With Err
            MsgBox "ERR#" & .Number _
                 & vbNewLine & .Description _
                 , vbOKOnly Or vbCritical
          End With
    Resume exitErrHandler

    End Sub

    Private Function FileExists(ByVal strPathFile As String) As Boolean
         On Error Resume Next
         FileExists = ((GetAttr(strPathFile) And vbDirectory) = 0)
     End Function

    HTH, ciao, Sandro.



    • Edited by Sandro Peruz Saturday, May 20, 2017 11:04 AM added explanation for deleting file
    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:40 PM
    Saturday, May 20, 2017 9:35 AM
  • Hello,

    You could add a new parameter ID to the Function and validate ID field value in the loop.

    Here is the example modified from your code.

    Sub test()
    Call SaveAttachments("C:\Desktop\", 3)
    End Sub
    Public Function SaveAttachments(strPath As String, ID As Integer, Optional strPattern As String = "*.*") As Long  'new parameter 
        Dim dbs As DAO.Database
        Dim rst As DAO.Recordset2
        Dim rsA As DAO.Recordset2
        Dim fld As DAO.Field2
        Dim strFullPath As String
        'Get the database, recordset, and attachment field
        Set dbs = OpenDatabase(Name:="S:\May Tracker.accdb") 
        Set rst = dbs.OpenRecordset("Cash")
        Set fld = rst("Payment Details")
       
        'Navigate through the table
        Do While Not rst.EOF
            If rst("ID") = ID Then   '!!!!!!!! New Code    
            'Get the recordset for the Attachments field
            Set rsA = fld.Value
            'Save all attachments in the field
            Do While Not rsA.EOF
                If rsA("FileName") Like strPattern Then
                    strFullPath = strPath & "\" & rsA("FileName")
                    'Make sure the file does not exist and save
                    If Dir(strFullPath) = "" Then
                        rsA("FileData").SaveToFile strFullPath
                    End If
                    'Increment the number of files saved
                    SaveAttachments = SaveAttachments + 1
                End If
                'Next attachment
                rsA.MoveNext
            Loop
            rsA.Close
             End If   '!!!!!!! New Code
            'Next record
            rst.MoveNext
        Loop
        rst.Close
        dbs.Close
        Set fld = Nothing
        Set rsA = Nothing
        Set rst = Nothing
        Set dbs = Nothing
    End Function
    

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, May 22, 2017 7:38 AM
    Moderator
  • Hi Celeste,

    Thanks a lot. The code is working.

    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:40 PM
    Tuesday, May 23, 2017 2:40 PM
  • Hello,

    If your issue has been resolved, I suggest you mark helpful post as answer to close this thread.

    If your issue persists, please let me know. And if you have any new issue, please feel free to post new threads.

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:40 PM
    Wednesday, May 24, 2017 3:15 AM
    Moderator

All replies

  • Hi,

    When you say ID=1, are you referring to the ID value of the record or the attachment? In other words, are you asking how to extract the first attachment only? Or, are you asking how to extract all the attachments of only one record from the table?

    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:41 PM
    Friday, May 19, 2017 8:08 PM
  • Hi .theDBguy,

    Thanks for your reply. Yes, I am referring to the ID value of the record. I am asking how to extract all the attachments of only one record from the table, considering that if I will type ID No. = 1, it will extract all attachments in record with ID no. 1, I will type ID No. = 2 then it will extract  all attachments in record with ID no. 2 and so forth and so on. FYI.


    • Edited by Vlady Mhore Friday, May 19, 2017 8:56 PM
    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:41 PM
    Friday, May 19, 2017 8:56 PM
  • ciao Vlady,

    what about this, customizing all reference about exportation path and sql predicatoe ogf your scenario :

    Private Sub exportAttachments()
     On Error GoTo errHandler
     
        Dim rst             As dao.Recordset2
        Dim rstAttach       As dao.Recordset2
        Dim fldAttach       As dao.Field2
        Dim strSaveFullFile As String

        Const strSavepath As String = "c:\exporatatioPath\" ' to be customized"

        Set rst = DBEngine(0)(0).OpenRecordset("SELECT * FROM  yourTable WHERE IDPK = " & Me.IDPK, 4) 'dbforwardonly customze tableName and PkName
        Set fldAttach = rst!Attachments
        Set rstAttach = fldAttach.Value

        Do While Not rstAttach.EOF

            strSaveFullFile = strSavepath & "\" & rstAttach!FileName

            If FileExists(strSaveFullFile) Then Kill strSaveFullFile  ' be careful here, if the file exists routine will delete  it before saving   !!!!!
            rstAttach!FileData.SaveToFile strSaveFullFile
            rstAttach.MoveNext
        Loop
        VBA.MsgBox prompt:="Attachment Saved", _
                   buttons:=vbInformation, _
                   Title:="Information"        

    exitErrHandler:
        rstAttach.Close
        Set fldAttach = Nothing
        Set rstAttach = Nothing
        Exit Sub

    errHandler:
         With Err
            MsgBox "ERR#" & .Number _
                 & vbNewLine & .Description _
                 , vbOKOnly Or vbCritical
          End With
    Resume exitErrHandler

    End Sub

    Private Function FileExists(ByVal strPathFile As String) As Boolean
         On Error Resume Next
         FileExists = ((GetAttr(strPathFile) And vbDirectory) = 0)
     End Function

    HTH, ciao, Sandro.



    • Edited by Sandro Peruz Saturday, May 20, 2017 11:04 AM added explanation for deleting file
    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:40 PM
    Saturday, May 20, 2017 9:35 AM
  • Hello,

    You could add a new parameter ID to the Function and validate ID field value in the loop.

    Here is the example modified from your code.

    Sub test()
    Call SaveAttachments("C:\Desktop\", 3)
    End Sub
    Public Function SaveAttachments(strPath As String, ID As Integer, Optional strPattern As String = "*.*") As Long  'new parameter 
        Dim dbs As DAO.Database
        Dim rst As DAO.Recordset2
        Dim rsA As DAO.Recordset2
        Dim fld As DAO.Field2
        Dim strFullPath As String
        'Get the database, recordset, and attachment field
        Set dbs = OpenDatabase(Name:="S:\May Tracker.accdb") 
        Set rst = dbs.OpenRecordset("Cash")
        Set fld = rst("Payment Details")
       
        'Navigate through the table
        Do While Not rst.EOF
            If rst("ID") = ID Then   '!!!!!!!! New Code    
            'Get the recordset for the Attachments field
            Set rsA = fld.Value
            'Save all attachments in the field
            Do While Not rsA.EOF
                If rsA("FileName") Like strPattern Then
                    strFullPath = strPath & "\" & rsA("FileName")
                    'Make sure the file does not exist and save
                    If Dir(strFullPath) = "" Then
                        rsA("FileData").SaveToFile strFullPath
                    End If
                    'Increment the number of files saved
                    SaveAttachments = SaveAttachments + 1
                End If
                'Next attachment
                rsA.MoveNext
            Loop
            rsA.Close
             End If   '!!!!!!! New Code
            'Next record
            rst.MoveNext
        Loop
        rst.Close
        dbs.Close
        Set fld = Nothing
        Set rsA = Nothing
        Set rst = Nothing
        Set dbs = Nothing
    End Function
    

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, May 22, 2017 7:38 AM
    Moderator
  • Hi Celeste,

    Thanks a lot. The code is working.

    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:40 PM
    Tuesday, May 23, 2017 2:40 PM
  • Hello,

    If your issue has been resolved, I suggest you mark helpful post as answer to close this thread.

    If your issue persists, please let me know. And if you have any new issue, please feel free to post new threads.

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by Vlady Mhore Thursday, May 25, 2017 2:40 PM
    Wednesday, May 24, 2017 3:15 AM
    Moderator