Solved

Run Script in Outlook Rule

Posted on 2007-03-20
7
1,768 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
Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

 
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

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

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

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…
Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
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 …
CodeTwo Sync for iCloud (http://www.codetwo.com/sync-for-icloud?sts=6554) automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…

810 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