empty that inbox
in an effort to get my inbox down to zero i nicked a bit of VB script. as with anything on the web it doesn't quite work the way i wanted it. this is modified for my folder structure. i then added a button to outlook so that when i press the button it moves the current email to my archive.

Sub MoveSelectedMessagesToArchive()
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Dim objtemp As Outlook.MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objNS.Folders.Item("Mailbox - Paul Grew").Folders.Item("GTD Archive")
If objFolder Is Nothing Then
'i = MsgBox("Hi there", vbOKOnly + vbCritical)
MsgBox "This folder doesn’t exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If
If Application.ActiveExplorer.Selection.Count = 0 Then
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
End If
End If
Next
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub

Sub MoveSelectedMessagesToArchive()
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Dim objtemp As Outlook.MAPIFolder
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objNS.Folders.Item("Mailbox - Paul Grew").Folders.Item("GTD Archive")
If objFolder Is Nothing Then
'i = MsgBox("Hi there", vbOKOnly + vbCritical)
MsgBox "This folder doesn’t exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If
If Application.ActiveExplorer.Selection.Count = 0 Then
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
End If
End If
Next
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub
Labels: VBA



