Sending emails to multiple recipients using VBA

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.

Code:

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.

Hi JC1412City,

Welcome to the forum.

You mention that the code works that saves the files, I think it may be of importance to know where those files are being saved?
Is it a temp folder/ the users temp folder/ a folder you have set up - how does the other piece of code know where to save the files?

Secondly:
How does the cell below know where the files are?

Code:

Worksheets("Email Files Employee Report").Range("B5").Text

Can you open the file using the link in the cell above?

I suppose what I am getting to is potentially the user that it is failing for may not have access to the location of the saved files to be attached.

Lastly with the difference in users, are they all on PC or are some on MAC?

Sorry for all the questions - I was reading through the code and pondering the above.

Hi Thank you for getting back to me. I have answered your questions below with stars

You mention that the code works that saves the files, I think it may be of importance to know where those files are being saved?
Is it a temp folder/ the users temp folder/ a folder you have set up - how does the other piece of code know where to save the files?
**The file is a folder set up within the users local drive and the macro is amended to input the file location depending on the user. So the macro creates a file based on the worksheet name and then saves it in a specified location:

Code:

Dim wbThis As Workbook Dim ws As Worksheet Dim strFilename As String Application.ScreenUpdating = False 'Stops screen flickering' Application.DisplayStatusBar = True 'Opens up the status bar at the bottom of excel' Application.StatusBar = "Please be Patient, Macro is running...." 'Message in status bar' 'To hide sheets not being emailed by colour 'NOTE ANY SHEETS THAT ARE COLOURED MUST BE SELECTED FROM THE THEME PALLET BLOCK' For Each ws In Worksheets If ws.Tab.ColorIndex <> xlAutomatic And ws.Tab.TintAndShade <> 0 Then ws.Visible = xlSheetHidden End If Next 'Selects "visible" sheets only to copy & save individually into current location of THIS file' Set wbThis = ThisWorkbook For Each ws In ThisWorkbook.Worksheets If ws.Visible = True Then strFilename = "ENTER FOLDER LOCATION" & "/" & ws.Name 'Update this to a permanent path 'strFilename = wbThis.Path & "/" & ws.Name - this one works for the current file path you are in ws.Copy Set wbNew = ActiveWorkbook wbNew.SaveAs strFilename wbNew.Close End If Next ws

Files can be opened from this location and this worked fine when testing with the user.

Secondly:
How does the cell below know where the files are?

Code:

Worksheets("Email Files Employee Report").Range("B5").Text

Can you open the file using the link in the cell above?
**There is a worksheet that lists the file names and location using another macro as well as the relevant email address

I suppose what I am getting to is potentially the user that it is failing for may not have access to the location of the saved files to be attached.
**in all testing the user has been able to access the file and the are created within the designated folder as expected.

Lastly with the difference in users, are they all on PC or are some on MAC?
**All users are on a PC with Windows

Hope these answers help clarify.

Thanks

Thanks for the answers,

Does the cell below contain paths or just a path?

Code:

Worksheets("Email Files Employee Report").Range("B5").Text

Does it fail only when trying to send more than one file?

Hi
Cell B5 contains one path which is the same path indicated in the macro.

When I set up test emails on my pc all the files send, however when I change the file location to another users area it doesn't send and the debug error comes up. When I step through the macro it highlights the .send command as the issue.

If you swap the line:

Code:

.Send

With

Code:

.Display

Will it display the email with the attachment on the users computer that has the issue?