VBA Excel- Attaching multiple files and send email

zinah

Active Member
Joined
Nov 28, 2018
Messages
353
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have an excel sheet that has list of employees, and I need to send emails to each employee with specific file (depends on Employee ID), I named the files logically so that the macro attach the right file. I have below macro which works fine, and it create email and attach the required file. However, for some cases, I have some employees that have more than one files to attach. How can I make a condition that create one email per Employee and attach all the files in one email instead of separate emails?


Code:
Sub CreateNewMessage()Dim aOutlook As Object
Dim aEmail As Object
Dim obj As Object
Dim olInsp As Object
Dim myDoc As Object
Dim oRng As Object


Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)




Dim ToCc As Range, strBody, strSig As String
Dim fColorBlue, fColorGreen, fColorRed, fDukeBlue1, fDukeBlue2, fAggieMaroon, fAggieGray As String
Dim Greeting, emailContent As String
Dim emailOpen, emailMid1, emailMid2, emailMid3, emailClose, emailCustom, emailSig As String


Dim AttachmentPath, AttachmentNm As String
    AttachmentPath = "C:\Users\""\Documents\"




For Each ToCc In ActiveSheet.[A2:A3]
'''1em = 12pt = 16px = 100%
    'Large is 18 px which is around 13.5 pt
    'Larger is 19 px which is around 14 pt
    'Medium is 16 px which is around 12 pt
    'Small is 13 px which is around 10 pt
    'Smaller is 13 px which is around 10 pt
    'X-large is 24 px which is around 18 pt
    'X-small is 10 px which is around 7.5 pt
    'XX-large is 32 px which is around 24 pt
    'XX-small is 9 px which is around 7 pt


'=============================================================


Dim ToEmail, CcEmail, ToNm, CcNm As String
Dim DescrDt, LocID, DescrNm As String


    ToNm = Cells(ToCc.Row, [C1].Column).Value
    CcNm = Cells(ToCc.Row, [G1].Column).Value
    ToEmail = Cells(ToCc.Row, [E1].Column).Value
    CcEmail = Cells(ToCc.Row, [I1].Column).Value


    LocID = Cells(ToCc.Row, [K2].Column).Value
   ' DescrNm = Cells(ToCc.Row, [D1].Column).Value
   ' DescrNm = Cells(ToCc.Row, [K2].Column).Value
    DescrDt = "20190401"




    AttachmentNm = "Monthly Attrition_" & DescrDt & "__" & LocID & ".pdf"


Dim FileAttach As String
    FileAttach = AttachmentPath & AttachmentNm
   ' MsgBox FileAttach
    
'Exit Sub


'=============================================================


Set aEmail = aOutlook.CreateItem(0)


With aEmail
  .SentOnBehalfOfName = "name@company.com"
  .To = ToEmail
  .cc = CcEmail '& "; " & SupvEmail & "; " & HREmail
  .Subject = "Monthly Dashboard " & Application.WorksheetFunction.Proper(ToNm) & Chr(32) & Application.WorksheetFunction.Proper(DescrNm)
  '.Sensitivity = olConfidential
  .Attachments.Add FileAttach
  
    .display
'    .send
End With




NEXT_ToCC:
    Set aEmail = Nothing
    Set olInsp = Nothing
    Set myDoc = Nothing
    Set oRng = Nothing
Next ToCc




End Sub
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
I can give more details if required, but any thoughts/codes on above macro to accommodate my inquiry?
 
Upvote 0
Hi,

Can anyone help me with this macro please?
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,211
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top