Export (0) Print
Expand All

Application.AttachmentContextMenuDisplay Event

Office 2007
Occurs before a context menu is displayed for a collection of attachments.

Version Information
 Version Added:  Outlook 2007

Syntax

expression.AttachmentContextMenuDisplay(CommandBar, Attachments)

expression   An expression that returns an Application object.

Parameters

NameRequired/OptionalData TypeDescription
CommandBarRequiredCommandBarThe context menu to be displayed.
AttachmentsRequiredAttachmentSelectionThe collection of attachments for which the context menu is to be displayed.

Remarks

This event occurs before a context menu for one or more selected attachments is to be displayed, allowing the CommandBar object representing the context menu to be customized by an add-in.

Example

The following Visual Basic for Applications (VBA) sample adds a menu item, as a CommandBarButton object, to the context menu if one or more Attachment objects are selected in the active inspector. Selecting that menu item saves the selected Attachment objects to the desktop of the current user. The ContextMenuClose event is used to dispose of any remaining object references used by the sample.

The sample code must be placed in a class module such as ThisOutlookSession.

Visual Basic for Applications
Private Declare Function SHGetSpecialFolderLocation _
    Lib "shell32" (ByVal hWnd As Long, _
    ByVal nFolder As Long, ppidl As Long) As Long

Private Declare Function SHGetPathFromIDList _
    Lib "shell32" Alias "SHGetPathFromIDListA" _
    (ByVal Pidl As Long, ByVal pszPath As String) As Long

Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
    
Dim objAttachments As AttachmentSelection

Private Sub Application_AttachmentContextMenuDisplay( _
    ByVal CommandBar As Office.CommandBar, _
    ByVal Attachments As AttachmentSelection)

    Dim objButton As CommandBarButton
    
    On Error GoTo ErrRoutine
    
    If Attachments.Count > 0 Then

        ' Get a reference to the selected attachments
        ' so we can work with them in the
        ' SaveToDesktop routine.
        Set objAttachments = Attachments
        
        ' Create a new menu item and place it
        ' just after the Reply To All button
        Set objButton = CommandBar.Controls.Add( _
            msoControlButton, , , , True)
        
        ' Configure the menu item.
        With objButton
            .Style = msoButtonIconAndCaption
            .Caption = "Save to &Desktop"
            .FaceId = 355
            ' If you place this sample in a class module
            ' other than ThisOutlookSession, update this
            ' line of code to ensure that the OnAction
            ' property contains the correct project,
            ' class, and routine name.
            .OnAction = "Project1.ThisOutlookSession.SaveToDesktop"
        End With
    End If
    
EndRoutine:
    On Error GoTo 0
    Set objButton = Nothing
    Exit Sub
    
ErrRoutine:
    MsgBox Err.Number & " - " & Err.Description, _
        vbOKOnly Or vbCritical, _
        "Application_AttachmentContextMenuDisplay"
    GoTo EndRoutine
End Sub

Private Sub SaveToDesktop()
    Dim lngPidlFound As Long
    Dim lngFolderFound As Long
    Dim lngPidl As Long
    Dim strPath As String
    Dim objAttachment As Attachment
    
    Const CSIDL_DESKTOPDIRECTORY = &H10
    Const MAX_PATH = 260
    Const NOERROR = 0
    
    On Error GoTo ErrRoutine
    
    ' Obtain the physical path to the desktop folder
    ' for the current user.
    strPath = Space(MAX_PATH)
    lngPidlFound = SHGetSpecialFolderLocation( _
        0, CSIDL_DESKTOPDIRECTORY, lngPidl)
    
    If lngPidlFound = NOERROR Then
        lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
        If lngFolderFound Then
            strPath = Left$(strPath, _
                InStr(1, strPath, vbNullChar) - 1)
            If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        End If
    End If

    CoTaskMemFree lngPidl
    
    ' Save each selected attachment to the
    ' desktop folder.
    If strPath <> "" Then
        For Each objAttachment In objAttachments
            objAttachment.SaveAsFile strPath & objAttachment.FileName
        Next
    End If
    
EndRoutine:
    On Error GoTo 0
    Set objAttachment = Nothing
    Exit Sub
    
ErrRoutine:
    MsgBox Err.Number & " - " & Err.Description, _
        vbOKOnly Or vbCritical, _
        "SaveToDesktop"
    GoTo EndRoutine
End Sub

Private Sub Application_ContextMenuClose(ByVal ContextMenu As OlContextMenu)
    On Error Resume Next
    
    If ContextMenu = olAttachmentContextMenu Then
        ' Once the context menu closes, remove the
        ' object reference to the attachments.
        If Not (objAttachments Is Nothing) Then
            Set objAttachments = Nothing
        End If
    End If
    
    On Error GoTo 0
End Sub



Community Additions

ADD
Show:
© 2014 Microsoft