Adding New line in Mail

[sachin483]

I am sending mail from excel through lotus notes

in column "J" email address is there

in column "Q" Subject is there

in column "S" body of text

I want to add name of the person before column "S" ie:- in column "R" and then body will continue

and if possible attachment path can be given in one column so that the attachment can sent pdf or xlsx

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

        Sub SendEMail1(r As Long)
        Dim Email   As String, Subj   As String
        Dim Msg     As String, URL    As String

        'Get the email address
        Email = Cells(r, 10) & ";" & Cells(r, 11) 'column J;column K

        'Message subject
        Subj = Cells(r, 17)                       'column Q

        'Compose the message
        Msg = Cells(r, 19) & "," & vbCrLf & vbCrLf 'column S
                
        'Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

        'Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

        'Create the URL
        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

        'Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

        'Wait two seconds before sending keystrokes
        Application.Wait (Now + TimeValue("0:00:02"))
        Application.SendKeys "%1"
        End Sub

 

[BQardi]

Try:

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

        Sub SendEMail1(r As Long)
        Dim Email   As String, Subj   As String
        Dim Msg     As String, URL    As String

        'Get the email address
        Email = Cells(r, 10) & ";" & Cells(r, 11) 'column J;column K

        'Message subject
        Subj = Cells(r, 17)                       'column Q

        [COLOR="#FF0000"]'Insert name
        Msg = Cells(r, 18) & vbCrLf & vbCrLf      'column R[/COLOR]

        'Compose the message
        Msg = [COLOR="#FF0000"]Msg &[/COLOR] Cells(r, 19) & "," & vbCrLf & vbCrLf 'column S
                
        'Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

        'Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

        'Create the URL
        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

        'Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

        'Wait two seconds before sending keystrokes
        Application.Wait (Now + TimeValue("0:00:02"))
        Application.SendKeys "%1"
        End Sub

 

[sachin483]

Thanks its working fine can we add "CC" email id in column no "K" and can we sent attachment with giving the path in one column and add a signature in another column

 

[BQardi]

CC is possible and signature is possible but can only be pure text (generally mailto: is pure text). Note that signature would not be a true signature, just text added to the bottom of the body.
Attachments I'm not sure you can do at all with mailto:

But try this:

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

        Sub SendEMail1(r As Long)
        Dim Email   As String, Subj   As String
        Dim Msg     As String, URL    As String
        [COLOR="#FF0000"]Dim EmailCC As String

        'Get the email address
        Email = Cells(r, 10) 'column J

        'Get the CC email address
        EmailCC = Cells(r, 11) 'column K[/COLOR]

        'Message subject
        Subj = Cells(r, 17)                       'column Q

        'Insert name
        Msg = Cells(r, 18) & vbCrLf & vbCrLf      'column R

        'Compose the message
        Msg = Msg & Cells(r, 19) & "," & vbCrLf & vbCrLf 'column S

        [COLOR="#FF0000"]'Add signature to body
        Msg = Msg & vbCrLf & Cells(r, 20) 'Replace 20 with the column number of your signatures[/COLOR]
                
        'Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

        'Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

        'Create the URL
        URL = "mailto:" & Email [COLOR="#FF0000"]& "?CC=" & EmailCC & "&[/COLOR]subject=" & Subj & "&body=" & Msg

        'Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

        'Wait two seconds before sending keystrokes
        Application.Wait (Now + TimeValue("0:00:02"))
        Application.SendKeys "%1"
        End Sub

Please bare with me if the code doesn't work correctly, I'm sitting in a train on my phone writing this.

If you need the functionality of attachments and signature in html, you need to take a completely different approach and rewrite the entire code.
Check out Ron de Bruin's webpage: Excel Automation - Ron de Bruin
He has a lot of different, well-written code regarding sending emails from Excel...

 

[sachin483]

Thank a lot for your efforts i will try and let you know