A common problem for Outlookusers is handling incoming attachments, especially when they are a norm not theexception. However, there are ways to automate the handling of Outlookattachments by using either VBA or VSTO.
In this article, I look intothe handling of Outlook attachments using VSTO 2008. The objective here is tocreate an AddIn for Outlook 2007 that will automatically handle incomingattachments.
Start by creating a new VSTO2008 AddIn for Outlook. You can do by accessing:
1. File à New Project
2. Project Types à Office 2007
3. Outlook 2007 Add-in
You should name the Add-In andsave it. I chose the name OLSaveAttachmentAddIn. The image below shows the NewProject Window:
Figure 1: Creating a new Outlook Add-in Project
You can now click OK tocontinue to the next step. The next step will show you the ThisAddIn.vb windowcontaining the basic code for the Add-In class.
Our next objective is to create:
1. the events for handling the Outlook application and afew buttons from our popup menu;
2. the popup object and buttons;
3. a file system object that will point to the folderthat will hold the saved attachment
The three steps above are shownbelow. Comments are added to the code so that it can be better understood:
Public Class ThisAddIn
'Outlook object
Private WithEventsoOutlook As Outlook.Application
'Popup button to toggle save attachment on and off
Private WithEventsoBtnHandleSaveOnOff As Office.CommandBarButton
'Popup button to handle showing the "About" form
Private WithEventsoBtnHandleAbout As Office.CommandBarButton
'Popup button to handle showing the "Help" folderinside Outlook explorer
Private WithEventsoBtnHandleHelp As Office.CommandBarButton
'Outlook explorer
Private oActiveExplorer AsOutlook.Explorer
'Commandbar Popup object to be added to Outlook's main menu
Private oPopup AsOffice.CommandBarPopup
'Commandbar button to be added to the popup object
Private oBtn AsOffice.CommandBarButton
'Commandbar button to be used across different buttons
Private oBtnGeneral AsOffice.CommandBarButton
'File System object
Private oFileSystem AsObject
'Form "About". You must add a form object
Private ofrmAbout AsfrmAbout
'String for the location of where the attachments will besaved
Private ConststrconLocation As String= "C:\OLAttachments\"
Private SubThisAddIn_Startup(ByVal sender As Object, _
ByVal e AsSystem.EventArgs) Handles Me.Startup
'Author :Robert Martim
'Purpose : SetOutlook object, set active Outlook explorer, create menu and check toggle"Save Attachment" on/off
'Created on : 18April 2009
'Last updated : 18April 2009
oOutlook =Application
oActiveExplorer= oOutlook.ActiveExplorer
CreateMenu()
ToggleMe()
End Sub
Private SuboOutlook_NewMailEx(ByVal EntryIDCollection _
As String) Handles Application.NewMailEx
'Author :Robert Martim
'Macro Purpose : Newe-mail event. Check for attachment and process attachment
'Created on : 18April 2009
'Last updated : 18April 2009
Dim iFirst As Integer
Dim strEntryID As String
Dim iLength As Integer
Dim oEmail AsOutlook.MailItem
Try
'Try for e-mail attachment and process attachment
iFirst = 1
iLength =Len(EntryIDCollection)
strEntryID= Mid(EntryIDCollection, iFirst, (iLength - iFirst) + 1)
oEmail =Application.Session.GetItemFromID(strEntryID)
If HasAttachment(oEmail) ThenCall processAttachment(oEmail)
oEmail = Nothing
Catch ex As Exception
'Catch error and report to user
MsgBox(Err.Description, vbCritical, Err.Number)
End Try
End Sub
Sub processAttachment(ByValolEmail As Outlook.MailItem)
'Author :Robert Martim
'Macro Purpose :Process attachment.
'Created on : 18April 2009
'Last updated : 18April 2009
Dim oAttachment AsOutlook.Attachment
Dim strNewName As String
Try
'Try:
'Get registry value and see whether Save Attachment istoggled to True
If getRegistry("ToggleSaveAttachment")= True Then
'Check for sender whose attachment are to be saved
If olEmail.SenderEmailAddress = "rm@msofficegurus.com" Then
'Create File System Object
oFileSystem = CreateObject("Scripting.FileSystemObject")
'Check if folder exists. If not, create destination folder
If NotoFileSystem.FolderExists(strconLocation) ThenoFileSystem.CreateFolder(strconLocation)
'Loop through attachments and save them
For Each oAttachment In olEmail.Attachments
'If file already exists in destination folder,warn user
If oFileSystem.FileExists(strconLocation& oAttachment.DisplayName) Then
If MsgBox("Thefile '" & oAttachment.DisplayName & _
"' already exists. Do wish to use anothername?", _
vbQuestion +vbYesNo) = vbYes Then
strNewName =InputBox("Type the new file name with fileextension", _
"New name...", oAttachment.DisplayName)
oAttachment.SaveAsFile(strconLocation & strNewName)
End If
Else
'Otherwise, just save it.
oAttachment.SaveAsFile(strconLocation& oAttachment.DisplayName)
End If
Next
End If
oFileSystem = Nothing
End If
Catch ex As Exception
'Catch error and report to user
MsgBox(Err.Description, MsgBoxStyle.Critical, Err.Number)
End Try
End Sub
Function HasAttachment(ByValolEmail As Outlook.MailItem) As Boolean
'Author :Robert Martim
'Purpose :Function to determine if e-mail object has an attachment
'Created on : 18April 2009
'Last updated : 18April 2009
If olEmail.Attachments.Count >= 1 Then HasAttachment = True
End Function
Sub CreateMenu()
'Author :Robert Martim
'Purpose :Create menu
'Created on : 18April 2009
'Last updated : 18April 2009
Try
ResetMenu()
oPopup =oActiveExplorer.CommandBars("Menu Bar")_
.Controls.Add(Office.MsoControlType.msoControlPopup, , , , Temporary:=True)
oPopup.Caption = "Attachments"
oBtn =oPopup.Controls.Add(Office.MsoControlType.msoControlButton)
With oBtn
.Caption = "SaveAttachment?"
.Style= Office.MsoButtonStyle.msoButtonIconAndCaption
End With
oBtnHandleSaveOnOff = oBtn
oBtnGeneral= oPopup.Controls.Add(Office.MsoControlType.msoControlButton)
With oBtnGeneral
.BeginGroup = True
.Caption = "About"
.FaceId= 326
.Style= Office.MsoButtonStyle.msoButtonIconAndCaption
End With
oBtnHandleAbout = oBtnGeneral
oBtnGeneral= oPopup.Controls.Add(Office.MsoControlType.msoControlButton)
With oBtnGeneral
.Caption = "Help"
.FaceId= 984
.Style= Office.MsoButtonStyle.msoButtonIconAndCaption
End With
oBtnHandleHelp = oBtnGeneral
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, Err.Number)
End Try
End Sub
Sub ResetMenu()
'Author :Robert Martim
'Purpose :Reset the "Menu Bar"
'Created on : 18April 2009
'Last updated : 18April 2009
On Error Resume Next
oActiveExplorer.CommandBars.Item("MenuBar").Reset()
End Sub
Private SuboBtnHandleSaveOnOff_Click( _
ByVal Ctrl As _
Microsoft.Office.Core.CommandBarButton, _
ByRef CancelDefault AsBoolean) _
Handles oBtnHandleSaveOnOff.Click
'Author :Robert Martim
'Purpose :Button event to handle toggling "Save Attachment" on/off
'Created on : 18April 2009
'Last updated : 18April 2009
Try
oFileSystem= CreateObject("Scripting.FileSystemObject")
If NotoFileSystem.FolderExists(strconLocation) Then
oFileSystem.CreateFolder(strconLocation)
MsgBox("Your attachments will be saved in "& strconLocation, MsgBoxStyle.Information)
End If
Catch ex As Exception
MsgBox("Ensure you have a folder named 'OLAttachments'located at C:\", MsgBoxStyle.Critical)
End Try
'Call sub to save toggle value in the Registry for lateruse
Call saveRegistry("ToggleSaveAttachment",_
Not getRegistry("ToggleSaveAttachment"))
'Call sub to toggle this button according to the savedvalue in the Registry
Call ToggleMe()
oFileSystem = Nothing
End Sub
Private SubToggleMe()
'Author :Robert Martim
'Purpose :Toggle "Save Attachment" on/off according to saved Registry value
'Created on : 18April 2009
'Last updated : 18April 2009
Try
If Not getRegistry("ToggleSaveAttachment") = True Then
oBtn.State = Office.MsoButtonState.msoButtonUp
Else
oBtn.State = Office.MsoButtonState.msoButtonDown
End If
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, Err.Number)
End Try
End Sub
Function getRegistry(ByValstrKey As String)As Boolean
'Author :Robert Martim
'Purpose :Function to return the Registry saved value.
'Created on : 18April 2009
'Last updated : 18April 2009
On Error Resume Next
getRegistry =GetSetting("AddInProject", "AddInProjectValues", strKey)
If Err.Number <> 0 ThengetRegistry = False
End Function
Sub saveRegistry(ByValstrKey As String,ByVal blnSetting AsBoolean)
'Author :Robert Martim
'Purpose : Functionto save the value to the Registry
'Created on : 18April 2009
'Last updated : 18April 2009
On Error Resume Next
SaveSetting("AddInProject", "AddInProjectValues",strKey, blnSetting)
End Sub
Private SuboBtnHandleAbout_Click(ByVal Ctrl As _
Microsoft.Office.Core.CommandBarButton, _
ByRef CancelDefault AsBoolean) _
Handles oBtnHandleAbout.Click
'Author :Robert Martim
'Purpose :Button event to handle showing the "About" form.
'Created on : 18April 2009
'Last updated : 18April 2009
ofrmAbout = New frmAbout
ofrmAbout.ShowDialog()
End Sub
Private SuboBtnHandleHelp_Click(ByVal Ctrl As _
Microsoft.Office.Core.CommandBarButton, _
ByRef CancelDefault AsBoolean) _
HandlesoBtnHandleHelp.Click
'Author :Robert Martim
'Purpose :Button to handle the "Help". In this case, MS Office Gurus website isopened inside and Outlook folder
'Created on : 18 April 2009
'Last updated : 18April 2009
Dim oNS AsOutlook.NameSpace
Dim oInboxFolder AsOutlook.Folder
Dim oWebFolder AsOutlook.Folder
oNS =oOutlook.GetNamespace("MAPI")
oInboxFolder =oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Try
'Try to get the "Web Pages" folder
oWebFolder= oInboxFolder.Folders("Web Pages")
Catch ex As Exception
'If the folder does not exist, add it
oWebFolder= oInboxFolder.Folders.Add("Web Pages")
End Try
'Open MS Office Gurus URL in this folder
With oWebFolder
oWebFolder.WebViewURL = "http://msofficegurus.com/"
oWebFolder.WebViewOn = True
oActiveExplorer.CurrentFolder = oWebFolder
End With
oWebFolder = Nothing
oInboxFolder = Nothing
oNS = Nothing
End Sub
End Class
You can now run the OutlookAdd-in. A new menu will be added to the Menu Bar as shown below:
Figure 2: Custom menu added to the "Menu Bar"
The attachments will beautomatically (when the “Save Attachment?” button is toggled to ü) to the destination folder:
Figure 3: Saved attachments