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.

[georgiboy]

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?

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.

[JC1412City]

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:

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?

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

[georgiboy]

Thanks for the answers,

Does the cell below contain paths or just a path?

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

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

[JC1412City]

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.

[georgiboy]

If you swap the line:

.Send
With

.Display

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