Sending Email VBA from a Shared Mailbox

[tcfreer]

Folks just need a sense check and confirmation that this is the right way forward?

This my current code - It works fine and does what we need in terms of creating, attaching and sending e-mails

Sub Send_Files()
'File to e-mail out the corrosponding sheets for Suppliers were needed
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim CurrentRow As Long
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Sheets("Audit").Select
    Set sh = Sheets("Audit")
    Set OutApp = CreateObject("Outlook.Application")
    
    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    'For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeFormulas)
        'Enter the path/file names in the C column in each row
         CurrentRow = cell.Row
        If Cells(CurrentRow, 4) Like "?*@?*.?*" And _
        Cells(CurrentRow, 3) <> "" And Not Dir(Cells(CurrentRow, 3) & "") = "" Then 'Assumes Filepath is column C
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = Cells(CurrentRow, 4) 'Assumes Email is column D
                .Subject = "Food Innovations Orders Due Next Week"
                .Body = "Hi " & Cells(CurrentRow, 1) & vbNewLine & vbNewLine & _
              "Please see the attached Excel document listing your Food Innovations Purchase Orders due to various locations, within the next 10 days." & vbNewLine & _
              "We hope you find this document easy to use and that it doesn't take up too much of your time to address. " & vbNewLine & _
              "The item ship date is the current expected date for you to deliver or make our order ready for collection." & vbNewLine & _
              "If your planned date & qty is the same as ours, please reply with a simple e-mail stating as such" & vbNewLine & _
              "If your date or qty differs from our PO, please update in columns I and J respectively." & vbNewLine & _
              "Please add any orders planned within the next 10 days that do not appear on this spread sheet" & vbNewLine & _
              "Finally please save any changes and return the spreadsheet by 10am tomorrow and reply to ALL to ensure your response is not missed." & vbNewLine & _
              "If anything is unclear or you believe can be presented in a better format, please advise" & vbNewLine & _
              "Thanking you in advance and we appreciate your support and feedback whilst we fine tune this process" & vbNewLine & _
              "Food Innovations Supply Chain"
                'Assumes Name is column A
                .Attachments.Add Cells(CurrentRow, 3).Value
                .Send  'Or use .Display
            End With
            
            Cells(CurrentRow, 5) = Now
            Cells(CurrentRow, 6) = Environ("Username")
            Set OutMail = Nothing
        End If
    Next cell
    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Sheets("Summary Sheet").Select
    MsgBox "Completed"
End Sub

However we now have a shared mailbox to that we want to send from.

Am I right in thinking that at this point


.To = Cells(CurrentRow, 4) 'Assumes Email is column D

I add a line above that has the

.SentonBehalfofName = "Shared Mail Box" in there?

That should sort that out right?​

 

[paulxmw]

Hi here is the code i use


On Error Resume Next
With OutMail
.SentOnBehalfOfName = "a shared email box name here"
.to = Cws.Cells(Rnum, 1).Value
.Subject = "subject line here"
.HTMLBody = StrBody & RangetoHTML(rng) & sBody 'changed
.DeferredDeliveryTime = Delay
.Send 'use Display or Send
End With
On Error GoTo 0

Hope this helps

 

[tcfreer]

Brill thanks Paul

So adding in the .sentonbehalfofName in were I am looking to do is right

Thanks for a quick response that's awesome