Solved

Run Script in Outlook Rule

Posted on 2007-03-20
7
1,767 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
  • 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
Control application downtime with dependency maps

Visualize the interdependencies between application components better with Applications Manager's automated application discovery and dependency mapping feature. Resolve performance issues faster by quickly isolating problematic components.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

MS Outlook is a world-class email client application that is mainly used for e-communication globally.  In this article, we will discuss the basic idea about MS Outlook, its advanced features, and types of MS Outlook File formats.
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…
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…

920 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

16 Experts available now in Live!

Get 1:1 Help Now