Wybór konta przy nadawaniu wiadomości w Microsoft Outlook

Ze względu na powszechną możliwość korzystania z darmowych kont pocztowych, wiele osób decyduje się na używanie i synchronizację wiadomości z wielu skrzynek pocztowych. W programie Outlook 2007/2010 mamy możliwość wyboru konta przed wysłaniem wiadomości (Rys.1.).

 
Rys.1. Ręczny wybór konta przed wysłaniem wiadomości

Niestety, często zdarza się, iż w czasie pracy zapominamy ustawić odpowiednie konto dla nadawanej wiadomości, a o błędzie zdajemy sobie sprawę już po fakcie. Można temu zapobiec opóźniając nadanie wiadomości stosowną regułą i wyedytować ją zanim zostanie wysłana.

Poniższe makro umożliwia alternatywny sposób wyboru konta nadawanej wiadomości.

Rys.2. Alternatywne okno, które pojawi się przed wysłaniem wiadomości
 

W przypadku, kiedy użytkownik wpisze w powyższym oknie (Rys.2.) wartość błędną, wiadomość nie zostanie wysłana oraz zostanie wyświetlony stosowny komunikat.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'MVP Shon Oskar - VBATools.pl
    If Item.Class = 43 Then
        Dim objMailItem As MailItem, ChangeMail As MailItem
        objMailItem = Item
        Dim olNS As Outlook.NameSpace
        olNS = Application.GetNamespace("MAPI")
        Dim wybor$, lista$, x&
        For x = 1 To olNS.Accounts.Count
            lista = lista & x & " -" & olNS.Accounts.Item(x).DisplayName & vbCr
        Next x
        wybor = InputBox("Wybierz numer konta z poniższej listy:" & vbCr & lista, _
                         "Nadawanie z wybranego konta VBATools.pl", 1)
        If Len(wybor) = 0 Then Cancel = True
        With objMailItem
            If IsNumeric(wybor) = True Then
                If wybor > x Then GoTo blad
                Set objMailItem = Item
                With objMailItem
                Set ChangeMail = .Copy
                    .Delete
                    Cancel = True
                End With
                With ChangeMail
                    .SendUsingAccount = olNS.Accounts.Item(wybor)
                    .Save
                    .Send
                End With
            Else
blad:
                Cancel = True
                MsgBox("Nie wybrano prawidłowo numeru konta", vbExclamation, _
                       "Nadawanie z wybranego konta VBATools.pl")
            End If
        End With
        Set ChangeMail = Nothing
        Set objMailItem = Nothing
        Set olNS = Nothing
    End If
End Sub 

Powyżej przedstawioną procedurę umieszczamy w klasie „ThisOutlookSesion”. 

Może być wymagany zapis procedury oraz ponowne uruchomienie MS Outlook.

Shon Oskar – www.VBATools.pl