Sending emails to multiple recipients using VBA

[JC1412City]

Hi

I have the below VBA code which should send separate files within a designated file location to individually listed email addresses within a worksheet.

This works in conjunction with another macro that saves each worksheet in a file location, the the below code is used to send out the emails. This works fine when tested on my pc however, this needs to be used by different departments and when I have changed the file location for specific users the macro throws up an error with the .send command. It is worth noting the macro which stores the files works fine and the files are created within the designated location as expected. The error comes with the emailing VBA

Can anyone help explain why this is happening. It is a recycled code so has had changes made to the file location and the tab names within the macro.

Does anyone have a simpler solution for what I need?

Thanks is advance, I am still learning and very much self taught when it comes to VBA.

Sub Step4_EmailFiles()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Counter As Integer
Counter = 0
Worksheets("Email Files Employee Report").Select 'Email
    Range("B2").Select
Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = True
'Select cell first line of data
    Worksheets("Create Files Employee Report").Select 'files
        Range("B5").Select 'file path
        Do Until IsEmpty(ActiveCell)
         Selection.Copy
         Application.StatusBar = ("E-mail sending in progress... " & Counter & " e-mails currently generated.")
         Worksheets("Email Files Employee Report").Select 'Email
         Range("B5").Select 'Attachment
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set OutApp = CreateObject("Outlook.Application")
         Set OutMail = OutApp.CreateItem(0)
' The following lines set out what is included in the Email.
                With OutMail
                    SentOnBehalfOfName = Worksheets("Email Files Employee Report").Range("B2").Text 'Email address to be sent from
                    .To = Worksheets("Email Files Employee Report").Range("B3").Text 'Email addresses to go to
                    .CC = Worksheets("Email Files Employee Report").Range("B4").Text 'Email to CC
                    .BCC = ""                                  'Email to BCC
                    .Subject = Worksheets("Email Files Employee Report").Range("B7").Text  'Subject matter
                    'Message details
                    .Body = Worksheets("Email Files Employee Report").Range("B9").Text & vbNewLine & vbNewLine & _
                            Worksheets("Email Files Employee Report").Range("B10").Text & vbNewLine & vbNewLine & _
                            Worksheets("Email Files Employee Report").Range("B11").Text & vbNewLine & vbNewLine & _
                            Worksheets("Email Files Employee Report").Range("B12").Text & vbNewLine & vbNewLine
                           'Worksheets("Email Files Employee Report").Range("B13").Text & vbNewLine & vbNewLine & _
                           'Worksheets("Email Files Employee Report").Range("B14").Text & vbNewLine & vbNewLine & _
                           'Worksheets("Email Files Employee Report").Range("B15").Text & vbNewLine & vbNewLine & _
                           'Worksheets("Email Files Employee Report").Range("B16").Text & vbNewLine & vbNewLine
                           .Attachments.Add Worksheets("Email Files Employee Report").Range("B5").Text
                    '.Save
                    .Send
                End With
        Counter = Counter + 1
        Worksheets("Create Files Employee Report").Select 'files
        Range("B5").Select 'file path
        'Steps down the counter value of rows from present location
        ActiveCell.Offset(Counter, 0).Select
    Loop
Calculate
Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
'Tidy sheets
Worksheets("Email Files Employee Report").Select
Range("B2").Select
Worksheets("Create Files Employee Report").Select
Range("B5").Select
Worksheets("Email List Employee Report").Select
Range("B2").Select
MsgBox ("E-mail generation now complete, please check your Outlook Sent items, there should be " _
    & Counter & " new Sent e-mails.")
End Sub

Thank you for any help you can offer.