VBA code - Subject, CC & BCC Selection in a specific columns

[VBAWannabee2]

Hi! So, I am new to VBA.
I have read Mr. Ron De Bruin excel automation and here I am.
My question is how can I set the Subject and CC in my email with this code from Mr. Ron.
My CC and Subject is in the Column C and D, respectively.

Sub xEmail
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("E1:Z1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.cc = 'this is my concern
.Subject = "Testfile" 'this is my concern
.Body = "Hi " & cell.Offset(0, -1).Value

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Send 'Or use .Display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Thank you! Please Help.

 

[DanteAmor]

Hi and welcome to MrExcel
Try this:

Sub xEmail()
  Dim OutApp As Object
  Dim OutMail As Object
  Dim sh As Worksheet
  Dim cell As Range
  Dim FileCell As Range
  Dim rng As Range
 
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With
 
  Set sh = Sheets("Sheet1")
 
  Set OutApp = CreateObject("Outlook.Application")
 
  For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    'Enter the path/file names in the C:Z column in each row
    Set rng = sh.Cells(cell.Row, 1).Range("E1:Z1")
    If cell.Value Like "?*@?*.?*" And _
      Application.WorksheetFunction.CountA(rng) > 0 Then
      Set OutMail = OutApp.CreateItem(0)
     
      With OutMail
        .to = cell.Value
        .cc = Range("C" & cell.Row)
        .Subject = Range("D" & cell.Row)
        .Body = "Hi " & cell.Offset(0, -1).Value
       
        For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
          If Trim(FileCell) <> "" Then
            If Dir(FileCell.Value) <> "" Then
              .Attachments.Add FileCell.Value
            End If
          End If
        Next FileCell
        .Send 'Or use .Display
      End With
     
      Set OutMail = Nothing
    End If
  Next cell
 
  Set OutApp = Nothing
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
  End With
End Sub

 

[VBAWannabee2]

Hi Sir DA,

This works perfectly. Thank you so much!
Also, thank you for welcoming me. Stay safe!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[VBAWannabee2]

I'm glad to help you. Thanks for the feedback.

Hi Sir DA,
Hope you're doing well. Apologies for this one but is there a way to set a specific email account to send such mail?
Like, I'm using my personal email but I want it to send by our groupmail.
Just for example;
My Mail - jay@test.com.ph
Groupmail - reportingsection@test.com.ph

Much thanks for your help!

 

[DanteAmor]

Review the following options:

Option 1)
After this line:

.to = cell.Value

Put this line:

.SendUsingAccount = OutMail.Session.Accounts.Item(2)

Change the 2 of Item(2), for the account number
You can see the account number if you select the Accounts:

Option 2)
After this line:

.to = cell.Value

Put this line:

.SentOnBehalfOfName = "reportingsection@test.com.ph"

I hope someone helps you...