Email Bulk Send. With excel Macro

[vaxo]

Hello Friends, I have Below Code: I need To replace this code so that I have more "CC" columns and "To" columns. I would attach excel macro file - how it would be looked like. How can i change this code to accomplish this?

Code: Select all

Option Explicit

Sub Send_Mails()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Bulk Email")
Dim i As Integer

Dim OA As Object
Dim msg As Object

Set OA = CreateObject("outlook.application")

Dim last_row As Integer
last_row = sh.Range("D" & Application.Rows.Count).End(xlUp).Row

For i = 6 To last_row

    If UCase(sh.Range("A" & i).Value) <> "YES" Then
        
            Set msg = OA.createitem(0)
            
            If sh.Range("C" & i).Value <> "" Then msg.SentOnBehalfOfName = sh.Range("C" & i).Value
            
            msg.To = sh.Range("D" & i).Value
            msg.cc = sh.Range("E" & i).Value
            msg.Subject = sh.Range("F" & i).Value
            msg.body = sh.Range("G" & i).Value
            
            If sh.Range("H" & i).Value <> "" Then
                msg.attachments.Add sh.Range("H" & i).Value
            End If
            
            If sh.Range("I" & i).Value <> "" Then
                msg.attachments.Add sh.Range("I" & i).Value
            End If
            
            If sh.Range("J" & i).Value <> "" Then
                msg.attachments.Add sh.Range("J" & i).Value
            End If
            
            If sh.Range("K" & i).Value <> "" Then
                msg.attachments.Add sh.Range("K" & i).Value
            End If
            
            If sh.Range("A1").Value = 1 Then
                msg.send
            Else
                msg.display
            End If
                
            sh.Range("B" & i).Value = "Done"
            
    End If
    
Next i

MsgBox "Process Completed!!!", vbInformation

End Sub

Sub Get_File_Path()
 
Dim file_path As String
file_path = Application.GetOpenFilename(MultiSelect:=False)
If file_path <> "False" Then
    Selection.Value = file_path
End If

End Sub

[HansV]

The following code allows you to add any number of To, C, BCC and Attachment columns to the right of column C. If row 1 contains To, Cc, Bcc, Body, or Subject, the column will be used for that purpose. If row 1 contains something else, the code assumes that the column contains an attachment path.

Code: Select all

Sub Send_Mails()
    Dim sh As Worksheet
    Dim i As Long
    Dim c As Long
    Dim last_row As Long
    Dim last_col As Long

    Dim OA As Object
    Dim msg As Object

    Set OA = CreateObject("outlook.application")

    Set sh = ThisWorkbook.Sheets("Bulk Email")
    last_row = sh.Range("D" & sh.Rows.Count).End(xlUp).Row
    last_col = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column

    For i = 6 To last_row
        If UCase(sh.Range("A" & i).Value) <> "YES" Then
            Set msg = OA.createitem(0)

            If sh.Range("C" & i).Value <> "" Then msg.SentOnBehalfOfName = sh.Range("C" & i).Value
            For c = 4 To last_col
                If sh.Cells(i, c).Value <> "" Then
                    Select Case UCase(sh.Cells(i, 1).Value)
                        Case "TO"
                            msg.Recipients.Add(sh.Cells(i, c).Value).Type = 1 ' olTo
                        Case "CC"
                            msg.Recipients.Add(sh.Cells(i, c).Value).Type = 2 ' olCC
                        Case "BCC"
                            msg.Recipients.Add(sh.Cells(i, c).Value).Type = 3 ' olBCC
                        Case "SUBJECT"
                            msg.Subject = sh.Cells(i, c).Value
                        Case "BODY"
                            msg.Body = sh.Cells(i, c).Value
                        Case Else ' Attachment
                            msg.Attachments.Add sh.Cells(i, c).Value
                    End Select
                End If
            Next c

            If sh.Range("A1").Value = 1 Then
                msg.send
            Else
                msg.display
            End If

            sh.Range("B" & i).Value = "Done"
        End If
    Next i

    MsgBox "Process Completed!!!", vbInformation
End Sub