Excel VBAでSendUsingAccountがエラーになる、アカウントが切り替わらない問題の対処法

投稿日：2022年8月16日

Excel VBAでメール送信をするプログラムを作成するとき、SendUsingAccountに送信元のメールアドレスを設定することで、アカウントの切り替えをすることができます。
検索すると以下のコードで動作するということで、実際にある程度動作します。
ただ、共有メールボックスを使っていたりすると、このコードでは、アカウントが切り替わらず、メインのアカウントでメールが作成されてしまうことがあります。

    Dim objOutlook As Object
    Dim objMail As Object
    
    objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    
    With objMail
    
        .SendUsingAccount = objOutlook.Session.Accounts.Item("[メールアドレス]")
         .Subject = "[件名]"
        
        .Body = "[本文]"
        .To = "[送信先メールアドレス]"
        .Attachments.Add ([添付ファイルのパス])
        
        'メールを作成して表示する場合　.Display
        '下書きに保存する場合　.Close (0)
        'そのまま送信する場合　.Send

    End With

Dim objOutlook As Object

Dim objMail As Object

objOutlook = CreateObject("Outlook.Application")

Set objMail = objOutlook.CreateItem(0)

With objMail

.SendUsingAccount = objOutlook.Session.Accounts.Item("[メールアドレス]")

.Subject = "[件名]"

.Body = "[本文]"

.To = "[送信先メールアドレス]"

.Attachments.Add ([添付ファイルのパス])

'メールを作成して表示する場合　.Display

'下書きに保存する場合　.Close (0)

'そのまま送信する場合　.Send

End With

SentOnBehalfOfName プロパティを使ってみたところ、エラーが発生したので
共有メールボックスのアクセス権の問題かと思い、一旦諦めかけましたが、
「SendUsingAccount VBA not working」というキーワードで検索していたところ、
以下のように書き換えれば動作することがわかりました。

.SendUsingAccount = objOutlook.Session.Accounts.Item("[メールアドレス]")
↓
Set .SendUsingAccount = objOutlook.Session.Accounts.Item("[メールアドレス]")