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???
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???