Why does the following code not work?

[bp]

I have downloaded the form Slapstick (Thanks Sue)
I have placed it in the ThisOutlookSession, and restarted OL. (BTW I have OL
2002 )
I have added a new extention AAA, since bat, exe and such are blocked.
I have made a folder call Quarentine in the Personal Folders (defualt
folder)
I have added a little msgbox where I think if the attachment is found, it
should show up. I am not gettng the message to move, not the pop up msg that
I should when a file (autoexec.aaa) is recieved.
What is wrong?

Thanks
Bp
------------------------------

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
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 strAttFldName As String
Dim strProgExt As String
Dim arrExt() As String
Dim objAtt As Attachment
Dim intPos As Integer
Dim I As Integer
Dim strExt As String

' #### USER OPTIONS ####
' name of Inbox subfolder containing messages with attachments
strAttFldName = "Quarantine"
' delimited list of extensions to trap
strProgExt = "exe, aaa, bat, com, vbs, vbe"

On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objAttFld = objInbox.Folders(strAttFldName)
If Item.Class = olMail Then
If objAttFld Is Nothing Then
' create folder if needed
Set objAttFld = objInbox.Folders.Add(strAttFldName)
End If
If Not objAttFld Is Nothing Then
' convert delimited list of extensions to array
arrExt = Split(strProgExt, ",")
For Each objAtt In Item.Attachments
intPos = InStrRev(objAtt.FileName, ".")
If intPos > 0 Then
' check attachment extension against array
strExt = LCase(Mid(objAtt.FileName, intPos + 1))
For I = LBound(arrExt) To UBound(arrExt)
If strExt = Trim(arrExt(I)) Then
MsgBox "Got one!"
Item.Move objAttFld
Exit For
End If
Next
Else
' no extension; unknown type

Item.Move objAttFld
End If
Next
End If
End If

On Error GoTo 0
Set objAttFld = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set objAtt = Nothing
End Sub

 

[bp]

The Startup application does not even launch.... I modified it like :

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
MsgBox "Welcome!!!"
End Sub

and no Welcome message.... Is there something I need to do?

 

[Sue Mosher [MVP-Outlook]]

Check your macro security setting -- Tools | Macros | Security.

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[bp]

Thanks! I was looking for that setting, and went Tools->Option->Security..
Guess what, it aint there! Thanks for pointing me down the correct menu!

Happy Easter to all!
Bp

 

[bp]

Sue,
How would I modify this to also watch a second folder (say, inbox2) but with
a differnet set of criteria? I am looking to watch this second folders for
HTML messages, so instead of the trap for the file extensions, I would trap
for
If (Len(oiMail.HTMLBody) <> 0) Then


Thanx
Bp

 

[Sue Mosher [MVP-Outlook]]

You would need to declare a second Items object WithEvents and instantiate
it in Application_Startup. You can then use its ItemAdd event.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[bp]

Sue, This is what I currently have...

Private WithEvents olInboxItems As Items
Private WithEvents olInbox2Items As Items



Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")

Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items

' trying for a scond, non
Dim objNS1 As NameSpace
'Set objNS1 = GetNamespace("MAPI")

'Following samples in the Helpfile This is what I came up with....
'I am not sure how to get the equivalant of GetDefaultFolder(olFolderInbox)
'I tried Getfolder, but that returned the wrong type

Set objfld1 = Application.Folders("Inbox2")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts) '?? but what
the sample showed...
Set olInbox2Items = myFolder.Folders(objfld1).Items

Set objNS = Nothing
'Set objNS1 = Nothing
'MsgBox "Welcome!!!"
End Sub

 

[Sue Mosher [MVP-Outlook]]

To get a non-default folder, you need to walk the folder hierarchy using the
Folders collections or use a function that does that for you. See
http://www.outlookcode.com/d/code/getfolder.htm

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[bp]

I had tried this earlier:
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")

Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set olInbox2Items = objNS.GetFolder("Personal Folders\Inbox2").Items

Set objNS = Nothing
End Sub

But I got a
run-time error '438':
Object doesn't support this property or method

I also have tried (among many other tests....)
test = GetFolder("Personal Folders\Inbox2") 'reports "Inbox2" in debug
' Set test2 = objNS.test


Set olInbox2Items = test.Items


Am I calling it wrong???

 

[bp]

BTW
THANKS SUE (Yes, that is yelling!!!!!)

Bp

I had tried this earlier:
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")

Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set olInbox2Items = objNS.GetFolder("Personal Folders\Inbox2").Items

Set objNS = Nothing
End Sub

But I got a
run-time error '438':
Object doesn't support this property or method

I also have tried (among many other tests....)
test = GetFolder("Personal Folders\Inbox2") 'reports "Inbox2" in debug
' Set test2 = objNS.test


Set olInbox2Items = test.Items


Am I calling it wrong???

 

[Sue Mosher [MVP-Outlook]]

You are not calling the GetFolder function correctly. It is not a method of
the Namespace object but a separate function:

Set olInbox2 = GetFolder("Personal Folders\Inbox2")
Set olInbox2Items = olInbox2.Items

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers