Hello,
I'm using your VBA code : Send personalized mass emails to a list from Excel but I've 2 extra questions for a codechange:
- How can I add the standard signature in the mail?
- How can i add a fixed attachement present in a folder?

Can someone help me changing the code?
Thanks a lot
Regards
Bart

#If VBA7 And Win64 Then

    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

                         ByVal hwnd As LongPtr, ByVal lpOperation As String, _

                         ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _

                         ByVal nShowCmd As Long) As LongPtr

#Else

    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _

                         ByVal hwnd As Long, ByVal lpOperation As String, _

                         ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _

                         ByVal nShowCmd As Long) As Long

#End If

Sub SendEMail()

'update by Extendoffice 20160506

    Dim xEmail As String

    Dim xSubj As String

    Dim xMsg As String

    Dim xURL As String

    Dim i As Integer

    Dim k As Double

    Dim xCell As Range

    Dim xRg As Range

    Dim xTxt As String

    On Error Resume Next

    xTxt = ActiveWindow.RangeSelection.Address

    Set xRg = Application.InputBox("Please select the data range:", "Kutools for Excel", xTxt, , , , , 8)

    If xRg Is Nothing Then Exit Sub

    If xRg.Columns.Count <> 3 Then

        MsgBox " Regional format error, please check", , "Kutools for Excel"

        Exit Sub

    End If

    For i = 1 To xRg.Rows.Count

'       Get the email address

        xEmail = xRg.Cells(i, 2)

'       Message subject

        xSubj = "Your Registration Code"

'       Compose the message

        xMsg = ""

        xMsg = xMsg & "Dear " & xRg.Cells(i, 1) & "," & vbCrLf & vbCrLf

        xMsg = xMsg & " This is your Registration Code "

        xMsg = xMsg & xRg.Cells(i, 3).Text & "." & vbCrLf & vbCrLf

        xMsg = xMsg & " please try it, and glad to get your feedback! " & vbCrLf

        xMsg = xMsg & "Skyyang"

'       Replace spaces with %20 (hex)

        xSubj = Application.WorksheetFunction.Substitute(xSubj, " ", "%20")

        xMsg = Application.WorksheetFunction.Substitute(xMsg, " ", "%20")

'       Replace carriage returns with %0D%0A (hex)

        xMsg = Application.WorksheetFunction.Substitute(xMsg, vbCrLf, "%0D%0A")

'       Create the URL

        xURL = "mailto:" & xEmail & "?subject=" & xSubj & "&body=" & xMsg

'       Execute the URL (start the email client)

        ShellExecute 0&, vbNullString, xURL, vbNullString, vbNullString, vbNormalFocus

'       Wait two seconds before sending keystrokes

        Application.Wait (Now + TimeValue("0:00:02"))

        Application.SendKeys "%s"

    Next

End Sub