Log in

View Full Version : Detecting when items are moved into a folder by a rule



mydesireduse
02-15-2007, 02:25 PM
First, I'm a complete noob to VBA. Didn't know what it stood for until recently. Im comfortable with C/C++ and Java, little php & perl, so I'm not a new programmer.

Found a great snippet of code here that I've slightly modified.(I'd link to original but forum software forbids based on noobie status)

'########################################################################## #####
'### Module level Declarations
'expose the items in the target folder to events
Option Explicit
Dim WithEvents TargetFolderItems As Items
'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\schedules\"

'########################################################################## #####
'### this is the Application_Startup event code in the ThisOutlookSession module
Private Sub Application_Startup()
'some startup code to set our "event-sensitive" items collection
Dim ns As Outlook.NameSpace
'
Set ns = Application.GetNamespace("MAPI")
Set TargetFolderItems = ns.Folders.Item( _
"Personal Folders").Folders.Item("Schedules").Items

End Sub

'########################################################################## #####
'### this is the ItemAdd event code
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
'when a new item is added to our "watched folder" we can process it
Dim olAtt As Attachment
Dim i As Integer
Dim retVal As Variant
If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
'save the attachment
olAtt.SaveAsFile FILE_PATH & olAtt.FileName

Next
End If

Set olAtt = Nothing

retVal = Shell("C:\schedules\winscp3.exe /script=C:\schedules\winscp.txt", vbNormalFocus)

End Sub

'########################################################################## #####
'### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()

Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing

End Sub


Anytime a message is manually dropped into the "Schedules" folder, this code automatically saves the attachments into "C:\schedules" After saving the attachments, I call WINSCP which runs a script that scp's the attachments over to a unix box.

HOWEVER, whenever I add a rule to automatically move a message from INBOX to schedules(based on sender and subject), this code does not run. It only activates on a manual add, not on a rule message move.

How can I modify this code so that it will detect incoming message moves into the Schedules folder and take the appropriate action??

I don't care if its a VBA-only solution, a rule, custom action, etc --- just so it works in Outlook 2003.

Thanks.

Keith

Steiner
02-16-2007, 12:25 AM
Hmm, that's strange, because I've basically the same code running here and it works quite fine with messages moved by a rule.
My rule here is a client-based one, might that be the difference?

Daniel

CCkfm2000
03-09-2007, 09:53 AM
please help

i keep getting an error message :- run time error - 1663827697 (9cd4010f) the operation failed - an object could not be found.

i've attached a screen copy.
i'm using outlook 2003.

thanks


'########################################################################## #####
'### Module level Declarations
'expose the items in the target folder to events
Option Explicit
Dim WithEvents TargetFolderItems As Items
Dim filename As String
'set the string constant for the path to save attachments
Const FILE_PATH As String = "R:\Coldstore\Department\Traffic_Sheets\"

'########################################################################## #####
'### this is the Application_Startup event code in the ThisOutlookSession module
Private Sub Application_Startup()
'some startup code to set our "event-sensitive" items collection
Dim ns As Outlook.NameSpace
'
Set ns = Application.GetNamespace("MAPI")
Set TargetFolderItems = ns.Folders.Item( _
"Personnel").Folders.Item("traffic sheets").Items ' problems with this line **************

End Sub

'########################################################################## #####
'### this is the ItemAdd event code
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
'when a new item is added to our "watched folder" we can process it
Dim olAtt As Attachment
Dim i As Integer

If Item.Attachments.Count > 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
'save the attachment
olAtt.SaveAsFile FILE_PATH & olAtt.filename

'if its an Excel file, pass the filepath to the print routine
If UCase(Right(olAtt.filename, 3)) = "XLS" Then
PrintAtt (FILE_PATH & olAtt.filename)
End If
Next
End If
filename = olAtt.filename
Set olAtt = Nothing

End Sub

'########################################################################## #####
'### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()

Dim ns As Outlook.NameSpace
Set TargetFolderItems = Nothing
Set ns = Nothing

End Sub

'########################################################################## #####
'### print routine
Sub PrintAtt(fFullPath As String)

'Dim xlApp As Excel.Application
'Dim wb As Excel.Workbook

'in the background, create an instance of xl then open, print, quit
'Set xlApp = New Excel.Application
'Set wb = xlApp.Workbooks.Open(fFullPath)
'wb.PrintOut
'xlApp.Quit

'tidy up
'Set wb = Nothing
'Set xlApp = Nothing
TestPlayWavFile
MsgBox "New Traffic Sheet - Now Saved to R:\Coldstore\Department\Traffic_Sheets\" & filename
End Sub