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.