tobin46
asked on
Run Script in Outlook Rule
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!
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!
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.
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.
ASKER
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()
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()
ASKER
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(olF olderInbox ).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. FileSystem Object")
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.Appli cation")
Set olDoc = olDocApp.Documents.Open(my TempFolder & "\" & objAtt.DisplayName)
olDoc.PrintOut
olDoc.Close 0
olDocApp.Quit
Set olDocApp = Nothing
Case "xls"
objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
Set olXlsApp = Application.CreateObject(" Excel.Appl ication")
Set olXls = olXlsApp.Workbooks.Open(my TempFolder & "\" & 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 .Applicati on")
Set olPpt = olPptApp.Presentations.Ope n(myTempFo lder & "\" & 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
Option Explicit
Dim objNS As NameSpace
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Set objNS = Application.GetNamespace("
Set olInboxItems = objNS.GetDefaultFolder(olF
End Sub
Private Sub Application_Quit()
Set olInboxItems = Nothing
Set objNS = Nothing
End Sub
Private Sub olInboxItems_ItemAdd(ByVal
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("
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,
Select Case strExt
Case "doc"
objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
Set olDocApp = Application.CreateObject("
Set olDoc = olDocApp.Documents.Open(my
olDoc.PrintOut
olDoc.Close 0
olDocApp.Quit
Set olDocApp = Nothing
Case "xls"
objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
Set olXlsApp = Application.CreateObject("
Set olXls = olXlsApp.Workbooks.Open(my
olXls.PrintOut
olXls.Close 0
Set olXls = Nothing
olXlsApp.Quit
Set olXlsApp = Nothing
Case "ppt"
objAtt.SaveAsFile myTempFolder & "\" & objAtt.DisplayName
Set olPptApp = Application.CreateObject("
Set olPpt = olPptApp.Presentations.Ope
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
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.
ASKER
I want to accomplish the following:
When an email is received from a certain user, I want to trigger the script.
When an email is received from a certain user, I want to trigger the script.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
See http://support.microsoft.com/kb/306108/ for details.