PDA

View Full Version : Create a Rule to Run Macro



dwhite30518
10-22-2013, 03:33 PM
Good evening everyone!!!

I have the follwoing code that works well to save attachment to a specified location...


Sub SaveRSA()

Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim strDateFileName As String
Dim strFileExtension As String
Dim dtDate As Date
Dim dName As String

strFolderpath = "S:\Departments\Service & Production\Public\TDC Delivery Information"
On Error Resume Next

Set objOL = CreateObject("Outlook.Application")

Set objSelection = objOL.ActiveExplorer.Selection


strFolderpath = strFolderpath & "\RSA Received - 2013\"


For Each objMsg In objSelection

Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count

If lngCount > 0 Then

dtDate = objMsg.SentOn

dName = Format(dtDate, "mm.dd.yyyy", vbUseSystemDayOfWeek, vbUseSystem)

For i = lngCount To 1 Step -1
If objAttachments.Item(i).Size > 5200 Then

strFile = objAttachments.Item(i).FileName

sName = Left$(strFile, 7)

strFileExtension = ".pdf"

strFile = strFolderpath & sName & " - " & dName & strFileExtension

objAttachments.Item(i).SaveAsFile strFile
End If
Next i
End If

Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing

End Sub

I am trying to create a rule in Outlook to apply this macro but when I am in the wizard, and select the Run Script option, it does not show my macros available to select for the rule. How do I get this to work???

skatonni
10-24-2013, 04:25 PM
The single incoming message must pass to the code

http://support.microsoft.com/kb/306108


Sub SaveRSA(objMsg As Outlook.MailItem)

' Dim objOL As Outlook.Application
' Dim objMsg As Outlook.MailItem
.
.

' For Each objMsg In objSelection