I have two macros.
Macro 1 :
When I upload a file and Run Macro 1, I get 2 new sheets (Sheet 1 and Sheet 2) giving me the result.
I have a TABLE with list of people and their names and a condition(Y/N) column.
Column 1(Name) Column 2(Email) Column 3 (Condition Y/N)
I want to send out emails to all people in the TABLE whose name matches with the unique values(name) in one of the columns in the Sheet 1 generated after running Macro 1.
So I want something that looks up the column in Sheet 1 and may be changes the Condition to Y in the TABLE for all unique names found in that Column in Sheet 1.(I can FILTER my TABLE in POWER QUERY to show only the rows with Condition “Y”.
Also when the SINGLE Outlook pops up with the all people in the “To” , I also want Sheet 1 or Sheet 2 to be attached to the Outlook.
Option Explicit Public Sub SendEmail() ' For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm ' Working in Office 2000-2016 ' Adapted by Ricardo Diaz ricardodiaz.co Dim OutApp As Object Dim OutMail As Object Dim sourceTable As ListObject Dim evalRow As ListRow Dim counter As Long Dim toArray() As Variant Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") Set sourceTable = Range("Table6").ListObject ' -> Set the table's name On Error GoTo cleanup ' Loop through each table's rows For Each evalRow In sourceTable.ListRows If evalRow.Range.Cells(, 2).Value Like "?*@?*.?*" And LCase(evalRow.Range.Cells(, 3).Value) = "yes" Then ReDim Preserve toArray(counter) toArray(counter) = evalRow.Range.Cells(, 2).Value counter = counter 1 End If Next evalRow ' Setup the email Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail ' Add gathered recipients For counter = 0 To UBound(toArray) .Recipients.Add (toArray(counter)) Next counter .Subject = "Reminder" .Body = "Dear All" _ & vbNewLine & vbNewLine & _ "Please comply with the transfers in the attached file. " & _ "Look up for your store and process asap." 'You can add files also like this '.Attachments.Add ("C:test.txt") ' -> Adjust this path .Display ' -> Or use Display End With On Error GoTo 0 Set OutMail = Nothing cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub
Code to Attach sheet 1 (doesn’t work)
file_name_import = Format(Now, "yyyy-mm-dd hh-mm-ss") file_name_import = file_name_import & " - File 1.xlsx" Worksheets("Sheet 1").Copy ChDir "H:Folder 1Folder 2Folder 3Folder 4" ActiveWorkbook.SaveAs Filename:= _ "H:Folder 1Folder 2Folder 3Folder 4File 1" & file_name_import, _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False .Attachments.Add "H:Folder 1Folder 2Folder 3Folder 4File 1" & file_name_import
So basically I want to add the above Code into the Code for Macro 2 so that when I run the Macro 2 my Outlook Pops up with all required people in “To” and with the attachment.
Thanks for the help!