CODEWITHSUNDEEP
vbaoutlook
iplayball27
iplayball27

Reputation: 71

Outlook 2016 - "select script" window in Rules Wizard is blank

I am trying to run the following Macro to save attachments into a folder on my computer:

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)

    Dim oAttachment As Outlook.Attachment
    Dim sSaveFolder As String
    sSaveFolder = "R:\ConfigAssettManag\Performance\Let's see if this works"

    For Each oAttachment In MItem.Attachments
        oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
        Next

End Sub

I cannot add the macro to the rule in Outlook for some reason. I read here that I needed to have it return an Outlook.MailItem, and my code already does that, so I do not know why the macro is still not showing up.Outlook Rule not showing my Macro

Upvotes: 3

Views: 3187

Answers (1)

HackSlash
HackSlash

Reputation: 5811

I think the answer is something obscure like you must declare ByRef like this:

Public Sub SaveAttachmentsToDisk(ByRef MItem As Outlook.MailItem)

Let me save you a whole bunch of time. You are going to find that using an Outlook rule to run your script doesn't work out. Instead, you will want to run your code on the actual event of a new mail item coming in. This will change the priority of your code and get you away from all the crazy bugs in Outlook rules. Thank me later.

Put this code in your "ThisOutlookSession" Object. It only works from there.

Option Explicit
Private WithEvents inboxItems As Outlook.Items

' Set up the listener on the Inbox
Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim objectNS As Outlook.NameSpace

    Set outlookApp = Outlook.Application
    Set objectNS = outlookApp.GetNamespace("MAPI")
    Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub

' Send new mail to the attachment processor
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
    If TypeName(Item) = "MailItem" Then
        Dim EMail As Outlook.MailItem
        Set EMail = Item
        Debug.Print "Incoming Data."
        SaveAttachmentsToDisk EMail
        Set EMail = Nothing
    End If
End Sub

For your saving the file, try this:

Dim fullPath As String
fullPath = sSaveFolder & oAttachment.FileName
oAttachment.SaveAsFile fullPath

Then put a break on the fullPath line and inspect the actual contents of that string during run-time. This will help you see where the files are actually going.

Upvotes: 2

Related Questions