Solved

Run Script in Outlook Rule

Posted on 2007-03-20
7
1,771 Views
Last Modified: 2008-01-09
Hello:
I've found a stream on EE that automaticall prints email attachments.  I have been able to plug this into ThisOutlookSession.  But, I don't want this macro 'firing' for every email.  I want to create a rule and run the script when emails are received for particular senders.  When I try to create the rule and 'run script', when I select script and the script pop up box appears, there are no scipts.  Why is this?

What do I need to do to have the script appear in the script selection box?

Thanks!
0
Comment
Question by:tobin46
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
7 Comments
 
LVL 9

Expert Comment

by:richdiesal
ID: 18762283
Scripts that appear there must be created in Outlook Visual Basic for Applications, not in Microsoft Visual Basic Scripting Edition (which is what Outlook has bundled with it).

See http://support.microsoft.com/kb/306108/ for details.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 18762439
For the script to appear in the selection box the script has to be declared in the following fashion:  Script/MacroName(Item As Outlook.MailItem)

It has to be declared this way because a rule passes the message that fired the rule as a parameter to the script/macro.  Only properly declared scripts/macros will appear in the list of macros available to be used with a rule.  Since the script isn't declared properly there may be other changes needed to make the script work from a rule.  If you'll post a link to the script, then I'll be glad to look it over and adjust it to make it work from a rule.
0
 
LVL 1

Author Comment

by:tobin46
ID: 18807713
Here is the code, I've put in the ThisOutloosSession:

I want this to show up when setting up rules in the script box.

Option Explicit
 Dim objNS As NameSpace

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
 
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 1

Author Comment

by:tobin46
ID: 18807730
Sorry, code didn't completely paste...
Option Explicit
 Dim objNS As NameSpace

Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
 
  Set objNS = Application.GetNamespace("MAPI")
  Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Application_Quit()
    Set olInboxItems = Nothing
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objAttFld As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strProgExt As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim i As Integer
Dim strExt As String
Dim fso As Object
Dim tempFolder As Object, myTempFolder As Object
Dim tempName As String
 
Dim olDocApp As Object
Dim olDoc As Object
Dim olXlsApp As Object
Dim olXls As Object
Dim olPptApp As Object
Dim olPpt As Object
 
  On Error Resume Next
If Item.Class = olMail Then
  Set fso = Application.CreateObject("Scripting.FileSystemObject")
  If Err.Number <> 0 Then
      Err.Clear
      MsgBox "Need to have WSH installed on your machine. Sorry, cannot zip", vbOK, "Error: cannot zip"
      Set fso = Nothing

      Exit Sub
  Else
      Set tempFolder = fso.GetSpecialFolder(2) 'TempFolder
      tempName = tempFolder & "\" & fso.GetTempName
      Set myTempFolder = fso.CreateFolder(tempName)
      For Each objAtt In Item.Attachments
        intPos = InStrRev(objAtt.FileName, ".")
        strExt = LCase(Mid(objAtt.FileName, intPos + 1))
        Select Case strExt
            Case "doc"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                Set olDocApp = Application.CreateObject("Word.Application")
                Set olDoc = olDocApp.Documents.Open(myTempFolder & "\" & objAtt.DisplayName)
                olDoc.PrintOut
                olDoc.Close 0
                olDocApp.Quit
                Set olDocApp = Nothing
            Case "xls"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                Set olXlsApp = Application.CreateObject("Excel.Application")
                Set olXls = olXlsApp.Workbooks.Open(myTempFolder & "\" & objAtt.DisplayName)
                olXls.PrintOut
                olXls.Close 0
                Set olXls = Nothing
                olXlsApp.Quit
                Set olXlsApp = Nothing
            Case "ppt"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                Set olPptApp = Application.CreateObject("Powerpoint.Application")
                Set olPpt = olPptApp.Presentations.Open(myTempFolder & "\" & objAtt.DisplayName)
                olPpt.PrintOut
                olPpt.Close 0
                Set olPpt = Nothing
                olPptApp.Quit
                Set olPptApp = Nothing
            Case Else
   
            End Select
        Set objAtt = Nothing
        Next

    Set tempFolder = Nothing
    fso.deleteFolder myTempFolder
    Set fso = Nothing
  End If
End If
0
 
LVL 76

Expert Comment

by:David Lee
ID: 18812770
The code as posted here cannot appear as a script option under rules.  This code is designed to react to Outlook events and run automatically.  I might be able to modify it to work from a rule, but to do that I need to know what it is that you want to accomplish.
0
 
LVL 1

Author Comment

by:tobin46
ID: 18813335
I want to accomplish the following:

When an email is received from a certain user, I want to trigger the script.  
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 18814503
Try this:

Sub MyScript(Item As MailItem)
Dim objAttFld As MAPIFolder
Dim objInbox As MAPIFolder
Dim objNS As NameSpace
Dim strProgExt As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim i As Integer
Dim strExt As String
Dim fso As Object
Dim tempFolder As Object, myTempFolder As Object
Dim tempName As String
 
Dim olDocApp As Object
Dim olDoc As Object
Dim olXlsApp As Object
Dim olXls As Object
Dim olPptApp As Object
Dim olPpt As Object
 
  On Error Resume Next
If Item.Class = olMail Then
  Set fso = Application.CreateObject("Scripting.FileSystemObject")
  If Err.Number <> 0 Then
      Err.Clear
      MsgBox "Need to have WSH installed on your machine. Sorry, cannot zip", vbOK, "Error: cannot zip"
      Set fso = Nothing

      Exit Sub
  Else
      Set tempFolder = fso.GetSpecialFolder(2) 'TempFolder
      tempName = tempFolder & "\" & fso.GetTempName
      Set myTempFolder = fso.CreateFolder(tempName)
      For Each objAtt In Item.Attachments
        intPos = InStrRev(objAtt.FileName, ".")
        strExt = LCase(Mid(objAtt.FileName, intPos + 1))
        Select Case strExt
            Case "doc"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                Set olDocApp = Application.CreateObject("Word.Application")
                Set olDoc = olDocApp.Documents.Open(myTempFolder & "\" & objAtt.DisplayName)
                olDoc.PrintOut
                olDoc.Close 0
                olDocApp.Quit
                Set olDocApp = Nothing
            Case "xls"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                Set olXlsApp = Application.CreateObject("Excel.Application")
                Set olXls = olXlsApp.Workbooks.Open(myTempFolder & "\" & objAtt.DisplayName)
                olXls.PrintOut
                olXls.Close 0
                Set olXls = Nothing
                olXlsApp.Quit
                Set olXlsApp = Nothing
            Case "ppt"
                objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
                Set olPptApp = Application.CreateObject("Powerpoint.Application")
                Set olPpt = olPptApp.Presentations.Open(myTempFolder & "\" & objAtt.DisplayName)
                olPpt.PrintOut
                olPpt.Close 0
                Set olPpt = Nothing
                olPptApp.Quit
                Set olPptApp = Nothing
            Case Else
   
            End Select
        Set objAtt = Nothing
        Next

    Set tempFolder = Nothing
    fso.deleteFolder myTempFolder
    Set fso = Nothing
  End If
End If
End Sub
0

Featured Post

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

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

Find out what you should include to make the best professional email signature for your organization.
Large Outlook files lead to various unwanted errors and corruption issues. Furthermore, large outlook files can also make Outlook take longer to start-up, search, navigate, and shut-down. So, In this article, i will discuss a method to make your Out…
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 …
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…

630 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