how to add cc in my macro when sending emails.

[excel_rooki]

I was given a macro that allows me to send emails with attachments to suppliers with only the information that relates to them, but I cannot cc recipients. I attempted to change it so I could CC, but I'm not sure how to change the macro. Any assistance would be greatly appreciated.

In sheet2, column c, beginning on row 2, is where I will add the email addresses to cc.

here is my macro

Sub test20221130B()

Dim rng As Range, c As Range, AddrRange As Range
Dim i As Long, lastRow As Long, lastRow2 As Long
Dim targetWorkbook As Workbook
Dim objFSO As Object
Dim varTempFolder As Variant, v As Variant
Dim AttFile As String, Dest As String
Dim sh As Worksheet, shMail As Worksheet

Set sh = Sheets("order book")
Set shMail = Sheets("Sheet2")

lastRow = sh.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lastRow2 = shMail.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set AddrRange = shMail.Range("A1:B" & lastRow2)

v = sh.Range("A2:v" & lastRow).Value

Set objFSO = CreateObject("Scripting.FileSystemObject")
varTempFolder = objFSO.GetSpecialFolder(2).Path & "\Temp " & Format(Now, "dd-mm-yyyy- hh-mm-ss")
objFSO.CreateFolder (varTempFolder)

Application.ScreenUpdating = False

With CreateObject("scripting.dictionary")

For i = 2 To UBound(v)
If Not .exists(v(i, 2)) Then
.Add v(i, 2), Nothing

With sh
sh.Range("A1").AutoFilter 2, v(i, 2)
Set rng = .AutoFilter.Range
Set targetWorkbook = Workbooks.Add
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
                
                 With targetWorkbook.Worksheets(Sheets.Count)
                    .Range("A1").PasteSpecial xlPasteColumnWidths
                    .Range("A1").PasteSpecial xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    .Range("A1").PasteSpecial xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                End With
                
AttFile = v(i, 2) & ".xlsx"
Dest = Application.WorksheetFunction.VLookup(v(i, 2), AddrRange, 2, False)

With targetWorkbook
'.ActiveSheet.Columns.AutoFit
.SaveAs varTempFolder & "" & AttFile
.Close
End With

With CreateObject("Outlook.Application").CreateItem(0)
.To = Dest
.Subject = "Subject"
.Body = "Please find the attached order book. please fill in the column that applies to you"
.Attachments.Add varTempFolder & "" & AttFile
.display 'to show
'.Send 'to send
End With

End With
End If

Next i
End With

Range("A1").AutoFilter
Application.ScreenUpdating = True

objFSO.deletefolder (varTempFolder)
End Sub 

order book sample.xlsx

[ByteMarks]

Maybe if you change AddRange to just column A and use a Match rather than a Vlookup to get the row of the matching supplier. Then you can retrieve the To and CC from columns B and C respectively.

Please Login or Register  to view this content.

[excel_rooki]

thank you for the help ByteMarks