Solved

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

Posted on 2016-08-16
7
87 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 13

Expert Comment

by:Alexei Kuznetsov
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 500 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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

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

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

Set OWA language and time zone in Exchange for individuals, all users or per database.
Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

707 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

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now