benjaminearle
Member
- Outlook version
- Outlook 2010 32 bit
- Email Account
- Exchange Server
Hello,
I was forced to get a new OS (Win7/32) and new Outlook (2010 32bit) after my hard drive started threatening a catastrophic failure (click click beep beep beep).
I had a nifty macro in my old outlook that i re-installed in my new but it is not functioning completely.
For background, the only factory settings I have changed in OL are to attach an original when replying, replying to all or forwarding (to preserve attachments). I have enabled macros.
The macro should (did in Outlook 2003 and 2007):
1. Delete the original when replying, replying all, forwarding
2. Force a folder choice upon send
Item #2 is working, so I know the macro is at least trying to run. I assume some portion of the code just needs some 2010-style massaging. Any help would be greatly appreciated. This little tool has helped me keep my inbox under 100 items for years now. Very helpful since my inbox truncates, irretrievably at 30d age.
Macro:
' </DeleteOriginalWhenReply
Option Explicit
Private WithEvents ReplyButton As Office.CommandBarButton
Private WithEvents ForwardButton As Office.CommandBarButton
Private WithEvents ReplyAllButton As Office.CommandBarButton
Private WithEvents m_Inspectors As Outlook.Inspectors
Private m_Mail As Outlook.MailItem
Private Sub Application_Startup()
Set ReplyButton = Application.ActiveExplorer.CommandBars.FindControl(, 354)
Set ForwardButton = Application.ActiveExplorer.CommandBars.FindControl(, 356)
Set ReplyAllButton = Application.ActiveExplorer.CommandBars.FindControl(, 355)
Set m_Inspectors = Application.Inspectors
End Sub
Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
On Error Resume Next
If Not m_Mail Is Nothing Then
m_Mail.Delete
Set m_Mail = Nothing
End If
End Sub
Private Sub ReplyButton_Click(ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean _
)
On Error Resume Next
If TypeOf Application.ActiveWindow Is Outlook.Explorer Then
Set m_Mail = Application.ActiveExplorer.Selection(1)
Else
Set m_Mail = Application.ActiveInspector.CurrentItem
End If
End Sub
' </DeleteOriginalWhenReply
' </Assign Folder for Sent Messages
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeOf Item Is Outlook.MailItem Then
Cancel = Not SaveSentMail(Item)
End If
End Sub
Private Function SaveSentMail(Item As Outlook.MailItem) As Boolean
Dim F As Outlook.MAPIFolder
If Item.DeleteAfterSubmit = False Then
Set F = Application.Session.PickFolder
If Not F Is Nothing Then
Set Item.SaveSentMessageFolder = F
SaveSentMail = True
End If
End If
End Function
' </Assign Folder for Sent Messages
Many many thanks and I hope once repaired this code can be useful to others as well. Both of these actions seem like things that could be factory-integrated into Outlook to reduce inbox size.
-Ben
I was forced to get a new OS (Win7/32) and new Outlook (2010 32bit) after my hard drive started threatening a catastrophic failure (click click beep beep beep).
I had a nifty macro in my old outlook that i re-installed in my new but it is not functioning completely.
For background, the only factory settings I have changed in OL are to attach an original when replying, replying to all or forwarding (to preserve attachments). I have enabled macros.
The macro should (did in Outlook 2003 and 2007):
1. Delete the original when replying, replying all, forwarding
2. Force a folder choice upon send
Item #2 is working, so I know the macro is at least trying to run. I assume some portion of the code just needs some 2010-style massaging. Any help would be greatly appreciated. This little tool has helped me keep my inbox under 100 items for years now. Very helpful since my inbox truncates, irretrievably at 30d age.
Macro:
' </DeleteOriginalWhenReply
Option Explicit
Private WithEvents ReplyButton As Office.CommandBarButton
Private WithEvents ForwardButton As Office.CommandBarButton
Private WithEvents ReplyAllButton As Office.CommandBarButton
Private WithEvents m_Inspectors As Outlook.Inspectors
Private m_Mail As Outlook.MailItem
Private Sub Application_Startup()
Set ReplyButton = Application.ActiveExplorer.CommandBars.FindControl(, 354)
Set ForwardButton = Application.ActiveExplorer.CommandBars.FindControl(, 356)
Set ReplyAllButton = Application.ActiveExplorer.CommandBars.FindControl(, 355)
Set m_Inspectors = Application.Inspectors
End Sub
Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
On Error Resume Next
If Not m_Mail Is Nothing Then
m_Mail.Delete
Set m_Mail = Nothing
End If
End Sub
Private Sub ReplyButton_Click(ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean _
)
On Error Resume Next
If TypeOf Application.ActiveWindow Is Outlook.Explorer Then
Set m_Mail = Application.ActiveExplorer.Selection(1)
Else
Set m_Mail = Application.ActiveInspector.CurrentItem
End If
End Sub
' </DeleteOriginalWhenReply
' </Assign Folder for Sent Messages
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeOf Item Is Outlook.MailItem Then
Cancel = Not SaveSentMail(Item)
End If
End Sub
Private Function SaveSentMail(Item As Outlook.MailItem) As Boolean
Dim F As Outlook.MAPIFolder
If Item.DeleteAfterSubmit = False Then
Set F = Application.Session.PickFolder
If Not F Is Nothing Then
Set Item.SaveSentMessageFolder = F
SaveSentMail = True
End If
End If
End Function
' </Assign Folder for Sent Messages
Many many thanks and I hope once repaired this code can be useful to others as well. Both of these actions seem like things that could be factory-integrated into Outlook to reduce inbox size.
-Ben
