Как отправить письмо от другой учетной записи Outlook

При отправке писем через Outlook иногда возникает ситуация, когда необходимо в качестве отправителя использовать не email(учетную запись) по умолчанию(как это происходит стандартно), а другую учетную запись.
Более подробно про отправку писем из Excel я рассказывал в статье: Как отправить письмо из Excel?
Вручную выбрать учетную запись Outlook для отправки от неё письма более чем просто: при создании письма надо нажать на кнопку "От" - раскроется список с доступными учетными записями, от которых можно отправить письмо

Кодом VBA это делается тоже несложно. Для примера код отправки писем я буду использовать из той же статьи(что по ссылке выше), но слегка облегченный и укороченный:

Option Explicit
 
Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object
 
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then
        Set objOutlookApp = Nothing
        Set objMail = Nothing
        Exit Sub
    End If
    'отменяем пропуск ошибок
    On Error GoTo 0
    'создаем сообщение
    With objMail
        .To = "AddressTo@mail.ru"                               'адрес получателя
        .Subject = "Отправка писем от разных учетных записей"   'Тема письма
        .Body = "Привет от www.Excel-VBA.ru"                    'Текст письма
        .Display    'если необходимо просмотреть сообщение, а не отправлять без просмотра
        '.Send       'если необходимо сразу отправить сообщение, без просмотра
    End With
 
    Set objOutlookApp = Nothing
    Set objMail = Nothing
End Sub

Код запускает Outlook, создает письмо с заданными темой, получателем и текстом письма и отображает это письмо(.Display). Отправка не происходит, чтобы можно было сначала посмотреть, что получилось в итоге.

Сначала давайте разберемся что такое учетная запись в Outlook. Просмотреть все учетные записи Outlook можно зайдя из самого Outlook: Файл -Настройка учетных записей:

Там отображены все доступные учетные записи, их имена и тип(POP3, IMAP и т.д.). Синеньким кружочком с галочкой отмечена учетная запись по умолчанию(именно из неё автоматом идет отправка всех создаваемых писем).
Так же нам понадобиться знать и тип подключения - через сервер Exchange(как правило это корпоративный вариант) или обычная пользовательская настройка учетной записи к своему личному почтовому ящику.

Вот и дошли до главного. Как я уже писал, по умолчанию Outlook кодом будет отправлять письмо именно от учетной записи, назначенной записью по умолчанию. И изменить это можно несколькими способами.
Для указания учетной записи отправителя применяются свойства письма .SentOnBehalfOfName или .SendUsingAccount. При этом .SentOnBehalfOfName у меня срабатывал как на обычной учетной записи, так и под Exchange. А вот .SendUsingAccount на Exchange протестировать уже не удалось. Поэтому при необходимости рекомендую опробовать оба варианта и выбрать тот, который будет работать.

метод SentOnBehalfOfName
Этот метод представляет собой текст, в котором указывается имя учетной записи. Недостаток: отправленные таким образом письма как правило у получателя отображаются просто адресом почты, даже если для учетной записи в адресной книге есть сопоставленные псевдонимы(например, если отправить письмо вручную от учетной записи "info@excel-vba.ru", то у получателя вместе с адресом может отображаться и псевдоним "Работа", в то время как при отправке кодом будет виден только адрес):

Option Explicit
 
Sub Send_Mail_ByOtherAccount()
    Dim objOutlookApp As Object, objMail As Object
 
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then
        Set objOutlookApp = Nothing
        Set objMail = Nothing
        Exit Sub
    End If
    'отменяем пропуск ошибок
    On Error GoTo 0
    'создаем сообщение
    With objMail
        .SentOnBehalfOfName = "account2@mail.thing"             'учетная запись, от которой отправить письмо
        .To = "AddressTo@mail.ru"                               'адрес получателя
        .Subject = "Отправка писем от разных учетных записей"   'Тема письма
        .Body = "Привет от www.Excel-VBA.ru"                    'Текст письма
        .Display    'если необходимо просмотреть сообщение, а не отправлять без просмотра
        '.Send       'если необходимо сразу отправить сообщение, без просмотра
    End With
    Set objOutlookApp = Nothing
    Set objMail = Nothing
End Sub

метод SendUsingAccount
А этот метод представляет собой объект существующей учетной записи, содержащий в себе все данные о ней, в том числе и псевдоним. Это значит, что такой метод отправки от другой учетной записи ничем не будет отличаться от отправки вручную:

Option Explicit
 
Sub Send_Mail_ByOtherAccount_()
    Dim objOutlookApp As Object, objMail As Object
 
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then
        Set objOutlookApp = Nothing
        Set objMail = Nothing
        Exit Sub
    End If
    'отменяем пропуск ошибок
    On Error GoTo 0
    'создаем сообщение
    With objMail
        'учетная запись, от которой отправить письмо
        Set .SendUsingAccount = objOutlookApp.Session.Accounts.Item("account2@mail.thing") 
        .To = "AddressTo@mail.ru"                               'адрес получателя
        .Subject = "Отправка писем от разных учетных записей"   'Тема письма
        .Body = "Привет от www.Excel-VBA.ru"                    'Текст письма
        .Display    'если необходимо просмотреть сообщение, а не отправлять без просмотра
        '.Send       'если необходимо сразу отправить сообщение, без просмотра
    End With
    Set objOutlookApp = Nothing
    Set objMail = Nothing
End Sub

В данном подходе очень важно правильно указать имя учетной записи, что не все делают правильно. Поэтому ниже я приведу код, который выведет на лист Excel имена всех учетных записей, чтобы можно было понять как именно их указывать в коде:

Sub GetOutlookAccounts()
    Dim objOutlookApp As Object, oAccount As Object
    Dim lr As Long
 
    On Error Resume Next
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    If Err.Number <> 0 Then
        Set objOutlookApp = Nothing
        Exit Sub
    End If
    For Each oAccount In objOutlookApp.Session.Accounts
        If oAccount.AccountType = 2 Then 'olPop3
            lr = lr + 1
            Cells(lr, 1).Value = oAccount
        End If
    Next
End Sub

Приведенный выше код надо скопировать в любую книгу Excel, перейти на чистый лист и запустить. На чистый лист потому, что код без предупреждения затирает данные первого столбца, начиная с первой ячейки.
Важно: указывать в коде учетную запись надо будет в точности как на листе вплоть до каждого символа(будь то пробел или тире).

Примечание: Есть информация, что данный метод изменения отправителя работает только в случае подключения по протоколу POP3(тип можно увидеть в настройках учетной записи). Поэтому, если указан иной вариант - может не сработать.

Если ни один из методов не срабатывает - то вполне возможно, что подключение просто не поддерживает такую возможность. И если уж кровь из носа надо это сделать - имеет смысл приглядеться к варианту отправки писем через CDO - там отправитель указывается изначально(надо лишь знать все данные сервера). Пример такого кода есть здесь же на сайте: Отправка сообщения без использования Outlook - используем CDO
Единственный момент, это если необходимо подставить в качестве отправителя псевдоним, а не только адрес. Тогда указывать надо именно в формате псевдонима:

sFrom = "Excel-vba <whois@excel-vba.ru>"

Управление профилями
Однако, не мог обойти стороной и тот момент, что может быть не только несколько учетных записей, но и несколько профилей со своими учетными записями. Несколько профилей могут настраиваться как в панели управления ОС: Панель управления -Mail -Конфигурации:

Так и в Outlook: Файл -Настройка учетных записей -Управление профилями:

Там может быть несколько профилей(например, если Вы работаете на аутсорсе и подключены к нескольким компаниям и периодически надо получать и отправлять письма от сервера Exchange конкретной компании или где-то Exchange, а где-то обычная почта) и там же настраивается использовать ли какой-либо профиль по умолчанию или всегда запрашивать выбор профиля.
Если необходимо отправить письмо от конкретного профиля, то сначала надо сменить профиль любым из перечисленных ниже способов:

• либо закрыть Outlook, зайти в панель управления и указать другой профиль в качестве профиля по умолчанию(если в настройках не указано запрашивать профиль при запуске): Панель управления -Mail -Конфигурации -Показать -Использовать конфигурацию и выбрать из списка нужный профиль.
• либо сменить профиль напрямую из Outlook: Файл -Настройка учетных записей -Изменить профиль. Outlook будет закрыт и его надо будет перезапустить вручную. Сразу после запуска будет показано окно выбора профиля. Выбираем нужный.

Теперь можно создавать письмо.
В кодах VBA на мой взгляд чуть меньше телодвижений: за подключение к конкретному профилю отвечает функция Logon объекта Session:
Session.Logon [имя профиля],[пароль],[показывать окно выбора профиля], [запускать в новой сессии]
Session.Logon [Profile],[Password],[Show dialog], [New Session]

• имя профиля(Profile) - имя профиля, в точности как оно записано в конфигурациях
• пароль(Password) - пароль от профиля
• показывать окно выбора профиля(Show dialog) - если указать True, то будет показано окно выбора профиля. Если известны имя профиля и пароль, то в кодах как правило указывают False(чтобы не показывать окно).
• запускать в новой сессии(New Session) - запускать ли профиль в новой сессии. На мой взгляд несколько спорный пункт, т.к. невозможно запустить Outlook от другого профиля, не закрыв текущий экземпляр приложения. Метод Logoff всего лишь выходит из сессии Exchange, но никак не из профиля.

В итоге в кодах выглядит это примерно так:

Sub Send_Mail_FromOtherProfile()
    Dim objOutlookApp As Object, objMail As Object
 
    On Error Resume Next
    'пробуем подключиться к Outlook
    Set objOutlookApp = GetObject(, "Outlook.Application")
    'Outlook открыт - принудительно закрываем, чтобы начать новую сессию
    If Not objOutlookApp Is Nothing Then
        objOutlookApp.Quit
    End If
    Err.Clear
    On Error GoTo 0
    Set objOutlookApp = CreateObject("Outlook.Application")
    'создаем новую сессию
    objOutlookApp.Session.Logon "Mail_Profile", "1234", False, True
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then
        Set objOutlookApp = Nothing
        Set objMail = Nothing
        Exit Sub
    End If
    'отменяем пропуск ошибок
    On Error GoTo 0
    'создаем сообщение
    With objMail
        .To = "AddressTo@mail.ru"                               'адрес получателя
        .Subject = "Отправка писем от разных учетных записей"   'Тема письма
        .Body = "Привет от Excel-VBA"                           'Текст письма
        .Display    'если необходимо просмотреть сообщение, а не отправлять без просмотра
'        .Send       'если необходимо сразу отправить сообщение, без просмотра
    End With
 
    Set objOutlookApp = Nothing
    Set objMail = Nothing
End Sub

Но пара ложек дегтя омрачает радость от полученной возможности:

• я уже писал, что для смены профиля необходимо обязательно перезапустить Outlook, и после этого перед запуском выбрать профиль. А это означает, что в коде VBA мы попадаем в замкнутый круг: .Session.Logon является методом самого Outlook и чтобы его вызвать необходимо запустить Outlook...А как только мы подключаемся к Outlook - у нас либо запускается профиль по умолчанию(что по факту лишает нас возможности указать другой профиль), либо выдается запрос на выбор профиля. По факту запуская кодом мы должны во время выполнения закрыть появившееся окно без выбора профиля(нажать кнопку "закрыть" не подтверждая какой-либо профиль) - тогда код продолжит выполняться и назначит указанный профиль.
• исходя из изложенного выше следует, что мы должны в настройках профилей указать "запрашивать конфигурацию". Иначе Outlook всегда будет запускаться с профилем, указанным по умолчанию без возможности его выбора, что сведет на нет все наши попытки его поменять в коде в момент запуска.

На данный момент я не нашел корректного способа обойти эти проблемы и поэтому код выше по сути приложен "до кучи". Хотя если речь идет не о простом подключении, а об Exchange - допускаю более корректную работу(но надо будет добавить перед Logon метод Logoff). Т.к. на данный момент у меня нет аккаунта Exchange, то проверить не могу.

Так же см.:
Как отправить письмо из Excel?
Вставить в письмо подпись из Outlook через VBA
Вставить в письмо Outlook таблицу Excel с форматированием
Сохранить вложения из Outlook в указанную папку

    Видеоуроки

Поиск по меткам