[Webinar] Streamline your web hosting managementRegister Today

x
?
Solved

Save Attachment Outlook Script - Modify to move email and mark as read

Posted on 2016-08-16
7
Medium Priority
?
159 Views
Last Modified: 2016-08-18
Save Outlook Attachments based on Subject

I want to modify the code to move the emails that have the Subject = "Eriksen | Invoice #",  and mark the messages as read.




Private WithEvents objInboxItems As Items

Private Sub Application_Startup()
    Dim objNS As NameSpace
    Set objNS = Application.GetNamespace("MAPI")
    ' instantiate Items collections for folders we want to monitor
    Set objInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
    Set MyInbox = objNS.GetDefaultFolder(olFolderInbox)
    Set objNS = Nothing
End Sub

Private Sub Application_Quit()
    ' disassociate global objects declared WithEvents
    Set objInboxItems = Nothing
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
    Dim olItems As Items, _
        olItem As Object, _
        olMailItem As MailItem, _
        olAttachmentItem As Attachment, _
        strInvoice As String, _
        strFileName As String


    Set olItems = objInboxItems.Restrict("[Unread] = True")
    For Each olItem In olItems
        If olItem.Class = olMail Then
            Set olMailItem = olItem
            'Selected based on the subject you want to key on
            If InStr(1, olMailItem.Subject, "Eriksen | Invoice #", vbTextCompare) > 0 Then
                If olMailItem.Attachments.Count > 0 Then
                
                strInvoice = Right(olItem, 6)
                    For Each olAttachmentItem In olMailItem.Attachments
                strFileName = "Eriksen_Invoice_" & strInvoice
                        'Change the path on the next line to the path you want to save your attachments in
                        olAttachmentItem.SaveAsFile "H:\My Documents\3_Purchase_Card\TransactionsFY2016\Eriksen_Translations\" & strFileName & ".pdf"
                olItem.UnRead = False
                       
                    Next
                End If
            End If
        End If
    Next
End Sub

Open in new window

0
Comment
Question by:Michael Spellman
  • 3
  • 3
7 Comments
 
LVL 15

Expert Comment

by:Alexei Kuznetsov (Outlook MVP)
ID: 41759484
Use olMailItem.Move() method and provide the destination folder as a parameter.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 41760435
Hi, mspellm.

If all you want to do is move the message to a folder and mark them as read, then you don't need to use this code.  You can do all of that with a rule.  My recommendation is to stick to Outlook's built-in features as much as possible and only resort to using code when your want to do something you can't do through a built-in feature.
0
 
LVL 76

Accepted Solution

by:
David Lee earned 2000 total points
ID: 41760443
Hi, mspellm.

Just saw your message to me.  I see that you want to add the following capabilities.

  • Move the email to another outlook folder or sub-folder of the Inbox
  • Print the attachment
  • Mark the email as read

That changes my earlier answer.

FIrst, create a new module in Outlook and add the following code to it.

Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Open in new window


Now, replace the code you have now with the code below.

Private WithEvents objInboxItems As Items

Private Sub Application_Startup()
    Dim objNS As NameSpace
    Set objNS = Application.GetNamespace("MAPI")
    ' instantiate Items collections for folders we want to monitor
    Set objInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
    Set MyInbox = objNS.GetDefaultFolder(olFolderInbox)
    Set objNS = Nothing
End Sub

Private Sub Application_Quit()
    ' disassociate global objects declared WithEvents
    Set objInboxItems = Nothing
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
    'On the next line, edit the path to the folder you want the messages moved to after processing
    Const TARGET_FOLDER = "name@company.com\inbox\folder name"
    Dim olItems As Items, _
        olItem As Object, _
        olAttachmentItem As Attachment, _
        olkFld As Outlook.MAPIFolder, _
        strInvoice As String, _
        strFileName As String, _
        strSaveFileName As String, _
        intIdx As Integer

    Set olkFld = OpenOutlookFolder(TARGET_FOLDER)
    Set olItems = objInboxItems.Restrict("[Unread] = True")
    For intIdx = olItems.Count To 1 Step -1
        Set olItem = olItems.Item(intIdx)
        If olItem.Class = olMail Then
            'Selected based on the subject you want to key on
            If InStr(1, olItem.Subject, "Eriksen | Invoice #", vbTextCompare) > 0 Then
                If olItem.Attachments.Count > 0 Then
                    strInvoice = Right(olItem, 6)
                    For Each olAttachmentItem In olItem.Attachments
                        strFileName = "Eriksen_Invoice_" & strInvoice
                        'Change the path on the next line to the path you want to save your attachments in
                        strSaveFileName = "H:\My Documents\3_Purchase_Card\TransactionsFY2016\Eriksen_Translations\" & strFileName & ".pdf"
                        olAttachmentItem.SaveAsFile strSaveFileName
                        ShellExecute 0&, "print", strSaveFileName, 0&, 0&, 0&
                    Next
                End If
                olItem.UnRead = False
                olItem.Save
                olItem.Move olkFld
            End If
        End If
    Next
End Sub

Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        bolBeyondRoot As Boolean
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function

Open in new window

1
Easily manage email signatures in Office 365

Managing email signatures in Office 365 can be a challenging task if you don't have the right tool. CodeTwo Email Signatures for Office 365 will help you implement a unified email signature look, no matter what email client is used by users. Test it for free!

 

Author Comment

by:Michael Spellman
ID: 41760819
Good Morning David,

It is doing everything except for printing the attached file.  
FYI - Running on Win 7 Pro SP1 64
0
 

Author Comment

by:Michael Spellman
ID: 41760869
It is doing everything except for printing the attached file.  
 FYI - Running on Win 7 Pro SP1 64
Office 2010 Pro 32-bit
0
 

Author Closing Comment

by:Michael Spellman
ID: 41761407
Thanks David!  After I fixed my issue with Adobe Acrobat, the print function worked fine.
I had to run the installation repair.  I noticed that the print function didn't appear in the context menu when right clicking on pdf files.
This is very helpful to me.  I can't say enough about it.  Excellent!

Mike
0
 
LVL 76

Expert Comment

by:David Lee
ID: 41761758
You're welcome, Mike.  Glad I could help out.
0

Featured Post

Free tool for managing users' photos in Office 365

Easily upload multiple users’ photos to Office 365. Manage them with an intuitive GUI and use handy built-in cropping and resizing options. Link photos with users based on Azure AD attributes. Free tool!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will help to fix the below errors for MS Exchange Server 2016 I. Certificate error "name on the security certificate is invalid or does not match the name of the site" II. Out of Office not working III. Make Internal URLs and Externa…
MS Outlook undoubtedly is the most widely used email client.Its user-friendliness, cost effectiveness, and availability with Microsoft Office Suite make it the most popular email application.  Its compatibility with Microsoft applications like Exch…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…
Suggested Courses

607 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question