How to send mass  emails from shared mailbox with VBA 

When reaching out to a large audience, it is common to use a shared Outlook email address rather than the one of specific users. 

When it comes to streamlining email dispatch from an Outlook shared mailbox, nothing quite matches the prowess of Visual Basic for Applications (VBA). 

In a previous post on  How to send Emails with attachments to multiple recipients  the code to use Excel to send emails was described.

This post shows the  possibility of using an Outlook shared mailbox, accessible by different users, outlining how this versatile tool can add great value to your email outreach strategy. 

The property that will be used is SentOnBehalfOfName

The below code integrates what is reported  at" How to send Emails with attachments to multiple recipients  " and integrates it with the  SentOnBehalfOfName 

Sub send_Emails()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Dim i As Integer, lstrw As Integer

Dim olApp As Object, olMail As Object

Dim filetosend As String, email As String, msg As String, subj As String

'The sheet containing email addresses and file locations is called Mailing 

Sheets("Mailing").Select

'lstrw is last row of the email list is identified and loop will stop when it is reached

lstrw = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lstrw

Set olApp = CreateObject("Outlook.Application")

Set olMail = olApp.CreateItem(0)

email = Cells(i, 1)

filetosend = Cells(i, 2)

msg = "Hi" & vbNewLine & "Please find attached your file" & vbNewLine & vbNewLine & "Best Regards"

subj = "Information for you"

With olMail

    .to = email 

    .Subject = subj    

  .body = msg    

    .attachments.Add filetosend    

'This is the property that allows to send from the shared mailbox. Insert the name of 

' the shared mailbox following the = sign 

' You need to be able to access the mail box in order to run the code

    .SentOnBehalfOfName = "shared@domain.com"

End With

Set olApp = Nothing

Set olMail = Nothing

Next i

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

End Sub