laustcozz
01-18-2013, 08:40 AM
Let me start by saying that my little vba project has been cobbled together mostly from code off of this forum and others and I am truly sorry if you see a scrap that is yours and I'm not citing you, I'm not trying to take credit for others work.
That said, I have a customer that insists on filing things with his delete key... Things never got permanently deleted how his old exchange was set up and he insists I get google apps working the same way or he will be terminating business with my company.
So I tried to put together a little script to move anything he put into "Deleted Items" into a folder on the same level as the inbox called "Deleted Saved" The code worked on my test systems for both Outlook 2007 and 2010 (His office uses both), but it does not work on his system. I get "Runtime Error '-2147221246 (80040102)': I don't know enough vba to even begin to troubleshoot. Any suggestions?
Private Sub Application_Quit()
Dim delItems As Outlook.Items
Dim FolderParent As Outlook.Folders
Dim ArchiveFolder As Outlook.MAPIFolder
Dim i As Long
' get items collection from Deleted Items folder
Set delItems = Outlook.Session.GetDefaultFolder(olFolderDeletedItems).Items
'Set folder parent to level above inbox
Set FolderParent = Outlook.Session.GetDefaultFolder(olFolderInbox).Parent.Folders
' Set Archive Folder = folder at same level as inbox
Set ArchiveFolder = FolderParent.Item("Deleted Saved")
' move items to archive folder
For i = delItems.Count To 1 Step -1
delItems.Item(i).Move ArchiveFolder
Next i
End Sub
That said, I have a customer that insists on filing things with his delete key... Things never got permanently deleted how his old exchange was set up and he insists I get google apps working the same way or he will be terminating business with my company.
So I tried to put together a little script to move anything he put into "Deleted Items" into a folder on the same level as the inbox called "Deleted Saved" The code worked on my test systems for both Outlook 2007 and 2010 (His office uses both), but it does not work on his system. I get "Runtime Error '-2147221246 (80040102)': I don't know enough vba to even begin to troubleshoot. Any suggestions?
Private Sub Application_Quit()
Dim delItems As Outlook.Items
Dim FolderParent As Outlook.Folders
Dim ArchiveFolder As Outlook.MAPIFolder
Dim i As Long
' get items collection from Deleted Items folder
Set delItems = Outlook.Session.GetDefaultFolder(olFolderDeletedItems).Items
'Set folder parent to level above inbox
Set FolderParent = Outlook.Session.GetDefaultFolder(olFolderInbox).Parent.Folders
' Set Archive Folder = folder at same level as inbox
Set ArchiveFolder = FolderParent.Item("Deleted Saved")
' move items to archive folder
For i = delItems.Count To 1 Step -1
delItems.Item(i).Move ArchiveFolder
Next i
End Sub