Saving Email Attachments To Folder

[DMT Dave]

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 ?

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

[DMT Dave]

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

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

[Welshgasman]

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.

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

[DMT Dave]

Hi welshgasman, thank you for your response, i will play around based on your code changing folder path etc....

thank you

[DMT Dave]

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

[Welshgasman]

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.?

[DMT Dave]

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

[DMT Dave]

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 ?????

[Welshgasman]

Don't use OneDrive ?

[DMT Dave]

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

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:

 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 ?

[Welshgasman]

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.

[DMT Dave]

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

[Gicu]

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,

[Welshgasman]

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?

[Gicu]

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,