Page 1 of 2 12 LastLast
Results 1 to 15 of 19
  1. #1
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,329

    Saving Email Attachments To Folder

    Hi Guy's hope you are all well, i have taken some of this code and made adjustments but i don't think i understand enough to get the result.



    I am trying to save any attachments from an inbox (in my case Item(2) that is currently open, so as long as a particular email is active and minimised:

    If there is 4 pdf files then save to folder
    if the next mail in inbox has no attachments, i guess we could have a Msg: No attachments in active mail
    If the next email has got 2 files then save them to folder ?

    Is any of this possible ?

    Here is what I copied from elsewhere but can't get it going ?

    Code:
    Dim objApp As ObjectDim MyApp As New Outlook.Application
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim MyItem As Object
    Dim objItem As MailItem
    Dim objAtts As Attachments
    Dim OutAcc As Outlook.Account
    Dim strMsg As String
    Dim intAns As Integer, i As Integer
    Dim intRes As Integer
    Dim strControl
    Dim ObjAtt
    Dim strFileName As String
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    
    
        Set MyItem = MyApp.CreateItem(olMailItem)
        
    '''''' Here ''''''''''''''''''''
    Set objFolder = MyApp.Session.Accounts.Item(2)
    ''''''''''''''''''''''''''''''''
    strControl = 0
        For Each objItem In objFolder.Items
        Set objAtts = objItem.Attachments
        strControl = strControl + 1
        If objAtts.Count > 0 Then
            If intRes = vbYes Then
                strMsg = "SAve attachments " & _
                "from " & (objItem.Subject) _
                & "?"
                intAns = MsgBox(strMsg, _
                vbYesNo + vbQuestion, _
                "Clean Attachments")
            Else
                intAns = vbYes
                End If
                If intAns = vbYes Then
                For Each ObjAtt In objAtts
                strFileName = "C:\Users\My Name\Desktop\EM Attachments\" & ObjAtt.FileName
                    ObjAtt.SaveAsFile strFileName
                Next
            End If
            objItem.Save
        End If
        Next
        
        For i = 1 To objFolder.Items.Count
            Set objItem = objFolder.Items(i)
            
            If Err = 0 Then
                If objItem.UnRead Then
                objItem.UnRead = False
                End If
            Else
                Err.Clear
            End If
            Next i
            MsgBox "No UnRead Items in Folder " & vbCrLf _
                & "   " & objFolder & ".", vbInformation
                
                MsgBox "All Attachments have been " & vbCrLf _
                 & "saved to C:\AuditorFileDates!", vbInformation

  2. #2
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,329
    Hi Guys, i have tried a different way of doing this and this is what i have but there is no response from the On Click event

    Code:
    Dim objAttachments As Outlook.AttachmentsDim myApp As New Outlook.Application
    Dim lngCount As Long
    Dim strFile As String
    Dim sFileType As String
    Dim i As Long
    Dim myItem As Outlook.MailItem
    
    
    Set myItem = myApp.CreateItem(olMailItem)
    Set objAttachments = myItem.Attachments
        lngCount = objAttachments.Count
    If myItem.Attachments.Count > 0 Then
     For i = lngCount To 1 Step -1
    ' Get the file name.
     strFile = objAttachments.Item(i).Filename
    
    
     ' Get the path to your My Documents folder
        strFolderpath = "T:\Email Att\"
        strFolderpath = strFolderpath & "\Attachments\"
    
    
    ' Combine with the path to the folder.
     strFile = strFolderpath & strFile
    
    
    ' Save the attachment as a file.
     objAttachments.Item(i).SaveAsFile strFile
    
    
     Next i
    End If

  3. #3
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    6,258
    Here is something I knocked up as in work we would get a lot of attachments.
    I would select a range of emails and then run this.

    Code:
    Public Sub ReplaceAttachmentsToLink()
        Dim objApp As Outlook.Application
        Dim aMail As Outlook.MailItem    'Object
        Dim oAttachments As Outlook.Attachments
        Dim oSelection As Outlook.Selection
        Dim oPA As PropertyAccessor
        Dim i As Long
        Dim iCount As Long
        Dim sFile As String
        Dim sFolderPath As String
        Dim sDeletedFiles As String
        Dim sDate As String, sTime As String
    
        Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
        
        ' Get the path to your My Documents folder
        sFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
        On Error Resume Next
    
        ' Instantiate an Outlook Application object.
        Set objApp = CreateObject("Outlook.Application")
    
        ' Get the collection of selected objects.
        Set oSelection = objApp.ActiveExplorer.Selection
    
        ' Set the Attachment folder.
        sFolderPath = sFolderPath & "\OLAttachments"
    
        'If folder does not exist create it
        If Dir(sFolderPath, vbDirectory) = "" Then
            MkDir sFolderPath
        End If
    
        ' Check each selected item for attachments. If attachments exist,
        ' save them to the Temp folder and strip them from the item.
        For Each aMail In oSelection
    
            ' This code only strips attachments from mail items.
            ' If aMail.class=olMail Then
            ' Get the Attachments collection of the item.
            Set oAttachments = aMail.Attachments
            iCount = oAttachments.Count
    
            If iCount > 0 Then
                ' We need to use a count down loop for removing items
                ' from a collection. Otherwise, the loop counter gets
                ' confused and only every other item is removed.
                For i = iCount To 1 Step -1
                    Set oPA = oAttachments.Item(i).PropertyAccessor
                    If oPA.GetProperty(PR_ATTACHMENT_HIDDEN) = False Then
                        ' Save attachment before deleting from item.
                        ' Get the file name.
                        sFile = oAttachments.Item(i).fileName
    
                        'Now get Date & Time as strings to use in filename, but use received date & time
                        sDate = Format(aMail.ReceivedTime, "yyyymmdd")
                        sTime = Format(aMail.ReceivedTime, "hhmmss")
    
                        ' Combine with the path to the Temp folder.
                        sFile = sFolderPath & "\" & sDate & "_" & sTime & "_" & sFile
    
                        ' Save the attachment as a file.
                        oAttachments.Item(i).SaveAsFile sFile
    
                        ' Delete the attachment.
                        oAttachments.Item(i).Delete
    
                        'write the save as path to a string to add to the message
                        'check for html and use html tags in link
                        If aMail.BodyFormat <> olFormatHTML Then
                            sDeletedFiles = sDeletedFiles & vbCrLf & "<file://" & sFile & ">"
                        Else
                            sDeletedFiles = sDeletedFiles & "<br>" & "<a href='file://" & _
                                            sFile & "'>" & sFile & "</a>"
                        End If
                    End If
                Next i
    
                ' Adds the filename string to the message body and save it
                ' Check for HTML body
                If aMail.BodyFormat <> olFormatHTML Then
                    aMail.Body = aMail.Body & vbCrLf & _
                                 "The file(s) were saved to " & sDeletedFiles
                Else
                    aMail.HTMLBody = aMail.HTMLBody & "<p>" & _
                                     "The file(s) were saved to " & sDeletedFiles & "</p>"
                End If
    
                aMail.Save
                'sets the attachment path to nothing before it moves on to the next message.
                sDeletedFiles = ""
    
            End If
        Next    'end aMail
    
    ExitSub:
    
        Set oAttachments = Nothing
        Set aMail = Nothing
        Set oSelection = Nothing
        Set objApp = Nothing
    End Sub
    HTH
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  4. #4
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,329
    Hi welshgasman, thank you for your response, i will play around based on your code changing folder path etc....

    thank you

  5. #5
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,329
    Hi Welshgasman, on your code, you select a range of emails to save the attachments, would there be much change in code to only select the active mail, a little like our previous subject called GrabMail, can i have a GrabFiles function similar as i wouldn't need your method of selecting a range of mails ?

    Kind Regards

  6. #6
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    6,258
    Quote Originally Posted by DMT Dave View Post
    Hi Welshgasman, on your code, you select a range of emails to save the attachments, would there be much change in code to only select the active mail, a little like our previous subject called GrabMail, can i have a GrabFiles function similar as i wouldn't need your method of selecting a range of mails ?

    Kind Regards
    As long as you can identify the active mail, no need for a loop.?
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  7. #7
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,329
    I have changed your sFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)

    To sFolderPath =
    C:\Users\davem\OneDrive\Desktop\Email Att ' this is a folder i made to test

    The result is it creates an empty folder within Email Att Folder

    Click image for larger version. 

Name:	Snip1.PNG 
Views:	17 
Size:	16.4 KB 
ID:	45381

  8. #8
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,329
    Hi welshgasman, ahhh my email now says these files were saved to (One Drive), how can I stop that and located them to a folder on my PC ?????

    Click image for larger version. 

Name:	Snip2.PNG 
Views:	17 
Size:	13.5 KB 
ID:	45382

  9. #9
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    6,258
    Don't use OneDrive ?
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  10. #10
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,329
    Hi welshgasman, i got your version working well and added a bit more code:

    Added this part to prompt a user if they have forgot to move to an email with expected files attached
    Code:
    If iCount = 0 Then        MsgBox ("There Are No Attchments On This E-Mail"), vbInformation + vbOKOnly, "NO ATTACHMENTS"
            Else
    And this part in case we don't want to delete from the email:
    Code:
     oAttachments.Item(i).SaveAsFile sFile                    If MsgBox("You Have Saved " & iCount & " Files To:" & vbNewLine & vbNewLine & _
                        "To: " & sFolderPath & vbNewLine & vbNewLine & _
                        "Do You Want To Delete Them From The E-Mail ?", vbQuestion + vbYesNo, "CONFIRMED") = vbNo Then
                        DoCmd.CancelEvent
                        Else
                        ' Delete the attachment.
                        oAttachments.Item(i).Delete
                        End If
    My next part of this, if we get images uploaded to a website as per image below, is there similar method of saving these files then opening ? I think the files are a link to an image on the web server i guess ?
    Once saved to maybe a folder called "webpics" then loop through and use something like Application.FollowHyperlink method ?
    Click image for larger version. 

Name:	Snip1.PNG 
Views:	15 
Size:	3.3 KB 
ID:	45384

  11. #11
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    6,258
    The whole point of my code was to delete the attachments?��
    I only supplied it to you to show how to save the attachments?
    I have never used a webserver for this, so you are on your own there.
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  12. #12
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,329
    Ok thank you, yes all deletes perfectly, i just thought i would tinker on and add some ifs and buts to it, more so a learning curve for me

    Thank you

  13. #13
    Gicu's Avatar
    Gicu is offline VIP
    Windows 10 Access 2010 32bit
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    4,235
    A quick Google search (access vba download image from url) turned out this among many others:
    https://www.access-programmers.co.uk...website.97064/

    And also this seems very promising:
    https://stackoverflow.com/questions/...save-to-folder

    Are those links embedded in the body of the message? You would have to extract them in a loop using Split() and then the trick will be to extract the URL from the link, you should look at HyperlinkPart.

    Cheers,
    Vlad Cucinschi
    MS Access Developer
    http://forestbyte.com/

  14. #14
    Join Date
    Jan 2017
    Location
    Swansea,South Wales,UK
    Posts
    6,258
    Quote Originally Posted by Gicu View Post
    A quick Google search (access vba download image from url) turned out this among many others:
    https://www.access-programmers.co.uk...website.97064/

    And also this seems very promising:
    https://stackoverflow.com/questions/...save-to-folder

    Are those links embedded in the body of the message? You would have to extract them in a loop using Split() and then the trick will be to extract the URL from the link, you should look at HyperlinkPart.

    Cheers,
    Vlad,
    DMT Dave can set the link to whatever he wants. he still however has to get the pictures to that location though?
    No need to extract the url I would have thought?
    Please use # icon on toolbar when posting code snippets.
    Cross Posting: https://www.excelguru.ca/content.php?184
    Debugging Access: https://www.youtube.com/results?sear...bug+access+vba

  15. #15
    Gicu's Avatar
    Gicu is offline VIP
    Windows 10 Access 2010 32bit
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    4,235
    I thought Dave is processing some received emails that have those links embedded in the body and he wants to download them from whatever web location they are hosted to a local folder, similar to what he is doing with the attachments.

    Cheers,
    Vlad Cucinschi
    MS Access Developer
    http://forestbyte.com/

Page 1 of 2 12 LastLast
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 2
    Last Post: 08-08-2019, 11:03 AM
  2. Saving attachment to folder
    By ino_mart in forum Programming
    Replies: 3
    Last Post: 10-29-2015, 07:53 AM
  3. Replies: 4
    Last Post: 03-11-2015, 12:01 PM
  4. Replies: 13
    Last Post: 03-25-2013, 02:04 PM
  5. Replies: 2
    Last Post: 04-26-2012, 02:55 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums