Solved

Outlook VBA; Run Script using "Rules"

Posted on 2009-05-13
14
1,698 Views
Last Modified: 2012-06-27
I am attempting to use the "Rules" to perform the following script. The script works when I "Run Now" but does not kick off on it's own when using the "Rules and Allerts"
Public Sub StripAttachments(objmail As MailItem)

    Dim objOL As Outlook.Application

    Dim objMsg As Object

    Dim objAttachments As Outlook.Attachments

    Dim objSelection As Outlook.Selection

    Dim i As Long

    Dim lngCount As Long

    Dim strFile As String

    Dim strFolder As String

    

    On Error Resume Next
 

    ' Instantiate an Outlook Application object.

    Set objOL = CreateObject("Outlook.Application")

    ' Get the collection of selected objects.

    Set objSelection = objOL.ActiveExplorer.Selection
 

    ' Get the Temp folder.

    strFolder = "\\ethserver2\ifshare\reports\"

    If strFolder = "" Then

        MsgBox "Could not get Temp folder", vbOKOnly

        GoTo ExitSub

    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 objMsg In objSelection

        ' This code only strips attachments from mail items.

        If objMsg.Class = olMail Then

            ' Get the Attachments collection of the item.

            Set objAttachments = objMsg.Attachments

            lngCount = objAttachments.Count

            If lngCount > 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 = lngCount To 1 Step -1

                    ' Save attachment before deleting from item.

                    ' Get the file name.

                    strFile = objAttachments.Item(i).FileName

                    ' Combine with the path to the Temp folder.

                    strFile = strFolder & strFile

                    ' Save the attachment as a file.

                    objAttachments.Item(i).SaveAsFile strFile

                    ' Delete the attachment.

                    objAttachments.Item(i).Delete

                Next i

            End If

            objMsg.Save

        End If

    Next
 

ExitSub:

    Set objAttachments = Nothing

    Set objMsg = Nothing

    Set objSelection = Nothing

    Set objOL = Nothing

End Sub

Open in new window

0
Comment
Question by:bradleydandrews
  • 7
  • 7
14 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 24379345
Hi, bradleydandrews.

Are you saying that you created a rule, set the rule's action to "run a script", selected this script as the script to run and it does not fire when the rule fires?
0
 

Author Comment

by:bradleydandrews
ID: 24379615
The script will only run if I manually select "Run Now" but it does not run if I let the "Rule and Alert" process the incoming e-mail.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24403062
I understand.  I'm trying to confirm the steps you went through to create the rule and set it to run a script.  Are the steps I listed the ones you followed?
0
 

Author Comment

by:bradleydandrews
ID: 24403408
Yes, I used the rules and alerts wizard that Outlook has for setting up a rule. The same rule looks at key words in the subject line, looks for any attachment and runs the script,
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24459263
Is this the only rule that doesn't work?
0
 

Author Comment

by:bradleydandrews
ID: 24483746
Yes, I have 6 others that work well. I have placed this rule at the top of the list. The only difference in this rule compared to the other working rules is that it is designated (client only)
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24487862
You aren't expecting this rule to work when Outlook isn't running are you?
0
Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

 

Author Comment

by:bradleydandrews
ID: 24487943
No, I would like it to run when I am logged on and running Outlook without having to manually "Run rules now".
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24488041
Ok.  You mentioned the "client only" difference so I just wanted to make sure.  Is this the only rule that runs a script?
0
 

Author Comment

by:bradleydandrews
ID: 24492757
Yes
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24498871
Ok, let's try a different macro.  Add the code below to Outlook, then create a new rule (any condition you want to use is fine) and set the rule's action to "run a script".  Choose this script as the one to run.  Does the macro fire properly?
Sub Testing(Item As Outlook.MailItem)

    MsgBox Item.Subject

End Sub

Open in new window

0
 

Author Comment

by:bradleydandrews
ID: 24502647
yes, fires a message box.
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 24505063
You said that the code worked properly when run manually, so I hadn't even looked at the code.  I was entirely focused on reasons why it wouldn't work when called from a rule.  I finally took a look at the code and it's obvious why it doesn't work.  The code was never intended to run from a rule.  It was keying on the items selected in an explorer window.  It completely ignored the received item that triggered the rule.  Unless you just happened to have a message with attachments selected when the rule fired the code would never work.  I've removed all the unnecessary code and changed it to work against the received item.  Please replace the code you have with the version below, then give it a test.
Public Sub StripAttachments(objMsg As MailItem)

    Dim i As Long

    Dim strFolder As String

    

    On Error Resume Next

    

    ' Get the Temp folder.

    strFolder = "\\ethserver2\ifshare\reports\"

    If strFolder = "" Then

        MsgBox "Could not get Temp folder", vbOKOnly

        GoTo ExitSub

    End If

 

    ' This code only strips attachments from mail items.

    If objMsg.Class = olMail Then

        For i = objMsg.Attachments.Count To 1 Step -1

            ' Save attachment before deleting from item.

            objMsg.Attachments.Item(i).SaveAsFile strFolder & objMsg.Attachments.Item(i).Filename

            ' Delete the attachment.

            objMsg.Attachments.Item(i).Delete

        Next i

        objMsg.Save

    End If

 

ExitSub:

End Sub

Open in new window

0
 

Author Closing Comment

by:bradleydandrews
ID: 31586777
Perfect. Thank you for taking the time to resolve my issue. The script works great to automatically strip attachments from incoming email using "Rules". Thanks again.
0

Featured Post

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

Question has a verified solution.

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

Suggested Solutions

What does UTC stand for?  “Coordinated Universal Time” – Think of this as the true time on Planet Earth that never changes with the exception of minor leap seconds here and there to account for the changes in the planet's rotation.   What does th…
Is your Office 365 signature not working the way you want it to? Are signature updates taking up too much of your time? Let's run through the most common problems that an IT administrator can encounter when dealing with Office 365 email signatures.
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…
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…

911 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

21 Experts available now in Live!

Get 1:1 Help Now