как изменить функцию "SentOnBehalfofName" в VBA

Question

Я новичок и только после окончания колледжа начал заниматься макросами. Мы работаем над обновлением Outlook, и этот макрос не работает, когда мы пытаемся отправлять электронные письма.

Как мне изменить свойство .sentonbehalfofname, чтобы это работало?

В настоящее время мы изменили общий доступ почтовый ящик с Exchange на обычную учетную запись. Почтовый ящик добавил нашу Outlook как обычную учетную запись.

Со следующим кодом я получаю сообщение об ошибке:

«Это сообщение не может быть отправлено. У вас нет разрешения на отправку сообщения. от имени указанного пользователя. "

Вот код VBA:

'   Construct email
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .SentOnBehalfOfName = "bbb@aaa.com"
            .BodyFormat = 2
            Set editor = .GetInspector.WordEditor
            editor.Content.Paste
            .To = currentEmailAddress
            .Subject = emailTitle & " ID:" & Range(teamMemberIDColumn & cell.Row).Value
            .Display
            .Send

Любая подсказка будет принята с благодарностью.

Answer 1

Согласно сообщению об ошибке, у вас нет разрешений на отправку от имени другого человека. Вы должны связаться с администратором Exchange, чтобы предоставить такие разрешения.

Другой возможный способ отправки от имени другого человека - использовать свойство MailItem.SendUsingAccount , которое устанавливает объект Account, представляющий учетную запись под которым должен быть отправлен MailItem. В этом случае вам необходимо настроить другую учетную запись в профиле Outlook. Вот пример сценария использования:

OutMail.SendUsingAccount = Application.Session.Accounts(1)

Answer 2

Попробуйте это

'Construct email
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .SendUsingAccount = Application.Session.Accounts("bbb@aaa.com")
            .BodyFormat = 2
            Set editor = .GetInspector.WordEditor
            editor.Content.Paste
            .To = currentEmailAddress
            .Subject = emailTitle & " ID:" & Range(teamMemberIDColumn & cell.Row).Value
            .Display
            .Send

Обратите внимание, что учетная запись bbb@aaa.com должна быть добавлена ​​и настроена в вашем Outlook, чтобы это работало.