Solved: Prevent me from deleting a folder

[Tommy]

Oh Yeah!

Ok try this one. I can place a break in the class to step through, and it works. I stop outlook and restart it it asks if I want to enable macros I pick enable macros and it complains or does nothing. The folder does not move.

I can only get it to work about 3 times in step mode.

And Yes I butchered some help files

Anyway if some one else wants to play:
In a class1
[VBA]
Dim myolapp As New Outlook.Application
Dim WithEvents myFolders As Outlook.Folders
Sub Initialize_handler()
Dim myNs As NameSpace
Set myNs = myolapp.GetNamespace("MAPI")
Set myFolders = myNs.GetDefaultFolder(olFolderInbox).Folders
End Sub
Private Sub myFolders_FolderRemove()
Dim MvitBck As Outlook.Folders
Dim myNs As NameSpace
Set myNs = myolapp.GetNamespace("MAPI")
Set MvitBck = myNs.GetDefaultFolder(olFolderDeletedItems).Folders
For i = 1 To MvitBck.Count
If Not MvitBck("kepfromdelete") Is Nothing Then
On Error Resume Next
MvitBck("kepfromdelete").MoveTo myNs.GetDefaultFolder(olFolderInbox)
Err.Clear
On Error GoTo 0
End If
Next
Set MvitBck = Nothing
End Sub

[/VBA]

In ThisOutlookSession

[VBA]
Private AllDay As Class1

Private Sub Application_Startup()
Set AllDay = New Class1
AllDay.Initialize_handler
End Sub


[/VBA]

[MOS MASTER]

Hi Tommy,

The problem however is that Matt has a passion For SHIFT+DELETE+ENTER....yepz you've guessed it the folder is now totaly gone!

But I like the approach and look at it later because most user just use Delete and could benefit from it!

[MOS MASTER]

Hi Tommy,

So done with the rest of the questions play time now!

It seams your code will trigger an error because excecution seams to fast! (That's great)

So we have to give Outlook some more time to proces the folder move!
We could set-up a timer but over here the error seams to vanish after I put one littel DoEvents (Yield to the system) in the sub!

For testing purposes all is in ThisOutlookSession so just copy paste it in there:[VBA]
Option Explicit
Dim myNs As Outlook.NameSpace
Dim WithEvents myFolders As Outlook.Folders

Sub Initialize_handler()
Set myNs = Application.GetNamespace("MAPI")
Set myFolders = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders
End Sub

Private Sub myFolders_FolderRemove()
Dim i As Integer
Dim MvitBck As Outlook.Folders
Dim myNs As Outlook.NameSpace

Set myNs = Application.GetNamespace("MAPI")
Set MvitBck = myNs.GetDefaultFolder(olFolderDeletedItems).Folders

For i = 1 To MvitBck.Count
If Not MvitBck("kepfromdelete") Is Nothing Then
DoEvents
MvitBck("kepfromdelete").MoveTo myNs.GetDefaultFolder(olFolderInbox)
End If
Next
Set MvitBck = Nothing
End Sub
Private Sub Application_Startup()
Initialize_handler
End Sub
[/VBA]

Could you test it and confirm it also works for you!

[Tommy]

Confirmed. XP pro, Office 2000 will test on XP home, Office 2003 tonight.


I figured it was the myolapp As New Outlook.Application, I thought I was looking one way and working another way since it seemed like I was cross referencing I had not considered not enough time for processing.

[MOS MASTER]

Confirmed. XP pro, Office 2000 will test on XP home, Office 2003 tonight.


I figured it was the myolapp As New Outlook.Application, I thought I was looking one way and working another way since it seemed like I was cross referencing I had not considered not enough time for processing.

Ah Great to see.

Well first I comment out you're Error handlings so I could get a real error msg from vba and when I had that one and code stepping worked flawlesly....

one and one got two!

Glad to see it's working on your side as well.

[mvidas]

I know it sounds strange but I use my deleted items folder as more of a "saved old messages" folder so my inbox doesn't get too large my fingers are so used to shift-delete-enter from windows explorer too, cant teach them any new tricks!

[MOS MASTER]

I know it sounds strange but I use my deleted items folder as more of a "saved old messages" folder so my inbox doesn't get too large my fingers are so used to shift-delete-enter from windows explorer too, cant teach them any new tricks!

ROTFL!

[Tommy]

LOL, they say that about old dogs too (cant teach them any new tricks)

[mdmackillop]

Not really "on topic" but for those of you who get emails advising of any new posts, Dave came up with some useful code to move duplicate entries.
http://www.vbaexpress.com/forum/showthread.php?t=1267

[mvidas]

Good call Malcolm, I use something just like that at home! I had to mark the moved ones as read though, otherwise my 'dups' folder had too many unread messages in it I wish it was faster, but from all my playing around I don't think it is possible.
When I get home I'll compare it to Dave's and Howard's methods, see if theirs are any faster. Thanks for the link!

[mdmackillop]

Hi Matt,
Since they are duplicates, I find it doesn't matter if they are marked Read or not, I check the ones left in the Inbox and just empty the Duplicates folder occasionally.

[Tommy]

Hi MOS MASTER,
Not confirmed, does not work with XP home and office 2003. I probably wasn't holding my mouth right, but I couldn't get it to even fire the event. I busted it out to class... and still couldn't get it to fire. I did notice that the Class_Terminate fired right after the Class_Initialize. I even set the security to low, and still no go.
Go figure.

[MOS MASTER]

Hi Tommy,

Strange over here it's working on Office XP and 2003???

Oh well...if there's time we'll try something else...

Don't know if I can program Matt fingers yet...

[mvidas]

Don't know if I can program Matt fingers yet...

[vba]Function ReprogramFingers(ByVal vUserName As String, ByVal oldKeyComb As String, _
ByVal newKeyComb As String) As Boolean
'Requires reference to "impossible.dll" found during standard installation at
' C:\Matt\can\be\an\idiot\and\wishes\MS\had\a\read\only\setting\for\folders\
Dim vUser As EndUser
Set vUser = EndUsers(vUserName)
If vUser.DeleteFolders = oldKeyComb Then
vUser.DeleteFolders = newKeyComb
Else
MsgBox "D'oh!"
End If
End Function[/vba]

[Tommy]

By the looks of it, Matt is having a problem with programming his fingers also Of course I could really use the "impossible.dll" sounds like we all could use some of the functionality found there!


I forgot my reading glasses so I could have been coding ummm who knows what! I started to get flustered when the events didn't fire, I'll look at it again, I was thinking on a keyboard hook for Matt's fingers using API but then we really start getting OS specific not to mention Office specific. May just be better to make an exe to help him out in Explorer also.

[MOS MASTER]

[vba]Function ReprogramFingers(ByVal vUserName As String, ByVal oldKeyComb As String, _
ByVal newKeyComb As String) As Boolean
'Requires reference to "impossible.dll" found during standard installation at
' C:\Matt\can\be\an\idiot\and\wishes\MS\had\a\read\only\setting\for\folders\
Dim vUser As EndUser
Set vUser = EndUsers(vUserName)
If vUser.DeleteFolders = oldKeyComb Then
vUser.DeleteFolders = newKeyComb
Else
MsgBox "D'oh!"
End If
End Function[/vba]

Truly Magnificent!

Yes like Tommy I'd like to receive a copy of "Impossible.dll" and I'm sure many others want it is wel..

You should enter it as a kbEntry...this will make a great add!