Macro to send different emails to different people with attachment

Hi Tenma

do you want three different for each country ?

Hi Tenma

Advise: don't mention dear france/Italy/spain in excel sheet macro will add dear francce/Italy/spain automatically based on column A just u need to enter the mail body part that's it ok

If u r using signature in outlook then change your outlook signature name in code I mention in code where to change.

Sub Mail_Report()
Dim MSht As Worksheet: Set MSht = ThisWorkbook.Sheets("Mail Setup")
Dim SigString As String, Signature As String

Dim OApp As Object, OMail As Object, MyStr As Variant, MyBody As Variant

If Left(Environ$("UserName"), 5) = "Tenma" Then
    snm = "Tenam" '----> U can change to Signature name
End If
SigString = Environ("appdata") & _
                "\Microsoft\Signatures\" & snm & ".htm"
If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
Else
    Signature = "Regards," & "<BR>" & Application.UserName
End If

With MSht
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    If lr = 1 Then MsgBox "There is no Data .... ! please check !": Exit Sub
    For i = 2 To lr
        MyStr = .Range("E" & i).Value
        MyBody = .Range("F" & i).Value
        If .Cells(i, 2).Value = "" And .Cells(i, 3).Value = "" And .Cells(i, 4).Value = "" Then
            MsgBox "Mail-Id's not mention for - " & .Range("A" & i).Value, vbInformation
        Else
            For j = 2 To 4
                If .Cells(i, j).Value <> "" Then
                    Set OApp = CreateObject("Outlook.Application")
                    Set OMail = OApp.CreateItem(0)
                    With OMail
                        .display
                        .To = MSht.Cells(i, j).Value
                        .CC = ""
                        .Subject = MyStr
                        .HTMLBody = "Dear " & MSht.Range("A" & i).Value & "<BR>" & "<BR>" & MyBody & "<BR>" & "<BR>" & Signature
                        .Attachments.Add MSht.Range("G" & i).Value
                        '.Send 'Remove Starting single quote to send directly to receipt
                    End With
                    Set OMail = Nothing
                    Set OApp = Nothing
                    ThisWorkbook.Activate
                End If
            Next
        End If
    Next
End With
MsgBox "Mails Created"
'SendKeys "^({v})", True
End Sub
Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

Please do let me know if u face any problem and I hope this will work perfect for u.

Hmm Ok give me some time I will get back to u shortly with appropriate solution