Macro code to generate Email..help

[Annielebo]

I have found a code that works well. It pulls information form cells out of my workbook and generates an outlook email ready to go.Except there seems to be a character limit on the string. Help me get past this. I am still in the begining stages of learning this. Here is my code (I did modify the body of the message. thanks for you help......


Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
For r = 2 To 2 'data in rows 2-6
' Message subject
Subj = "Action Right Now"

' Compose the message
Msg = ""
Msg = Msg & "Thank you for everything you have been a gracious host."
Msg = Msg & "Don’t fret everything will be alright. "
Msg = Msg & Cells(r, 1).Text
Msg = Msg & " as of this date "
Msg = Msg & Cells(r, 2).Text
Msg = Msg & " and time "
Msg = Msg & Cells(r, 3).Text & "."
Msg = Msg & " Your bill will be paid by me a host of "
Msg = Msg & Cells(r, 4).Text
Msg = Msg & (Cells(r, 5)) & "."
Msg = Msg & " The next step is to leave your name and address with the driver to ensure you are compensated well."
Msg = Msg & "This is what he will require:" & vbCrLf
Msg = Msg & "Mr. Biggs," & vbCrLf
Msg = Msg & "1. A left pocket filled with candy."
Msg = Msg & Cells(r, 6).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "2. A right pocket filled with cinnamon." & vbCrLf & vbCrLf
Msg = Msg & "3. If you have any questions do not hesitate to call me at 555-9292. Again thank you for your time." & vbCrLf & vbCrLf


' 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

Next r
End Sub

[CreganTur]

The easiest thing you can do to get around the character limit is to use multiple strings, instead of one single, very long, string.

I modified your code and broke the single string into multiple 'paragraph' strings. This is untested, so you may need to fiddle with it a little.

[vba]Sub SendEMail()
Dim Email As String, Subj As String
Dim URL As String
Dim Para1 As String, Para2 As String, Para3 As String, Para4 As String
Dim r As Integer, x As Double
For r = 2 To 2 'data in rows 2-6
' Message subject
Subj = "Action Right Now"

' Compose the message
Para1 = "Thank you for everything you have been a gracious host." _
& "Don’t fret everything will be alright. "

Para2 = Cells(r, 1).Text & " as of this date " & Cells(r, 2).Text & " and time " _
& Cells(r, 3).Text & "."

Para3 = " Your bill will be paid by me a host of " & Cells(r, 4).Text _
& (Cells(r, 5)) & "." & " The next step is to leave your name and address" _
& "with the driver to ensure you are compensated well."

Para4 = "This is what he will require:" & vbCrLf & "Mr. Biggs," & vbCrLf _
& "1. A left pocket filled with candy." & Cells(r, 6).Text & "." & vbCrLf & vbCrLf _
& "2. A right pocket filled with cinnamon." & vbCrLf & vbCrLf _
& "3. If you have any questions do not hesitate to call me at 555-9292." _
& "Again thank you for your time." & vbCrLf & vbCrLf


Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Dim Paras, p
Paras = Array(Para1, Para2, Para3, Para4)
For Each p In Paras
' Replace spaces with %20 (hex)
p = Application.WorksheetFunction.Substitute(p, " ", "%20")
' Replace carriage returns with %0D%0A (hex)
p = Application.WorksheetFunction.Substitute(p, vbCrLf, "%0D%0A")
Next p

' Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Para1 & Para2 & Para3 & Para4

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

Next r
End Sub[/vba]

Out of mobid curiosity: a left pocked filled with candy, a right pocket filled with cinamon ... WHAT!?

NinjaEdit: MD kindly reminded me that I forgot to deal with your replace functions- The array setup and For...Each loop to repalce the characters is MD's work, not mine.

[Annielebo]

HAHA... this code is for work. So I had to come up with some quick text to put in the place of my work information. The work I do we have to test departments and insert the information in the workbook at the end of this test I have to generate an email based on their score and send it out. Instead of cutting and pasting so many times, I decided to make this macro. But, its a little bit above of my head. I appreciate you assistance with this. I have been so confused on how to split it. I have not learned that one yet. Thank you soooooo much I will fiddle with it and test it. you are awesome. I will let you know how it goes. Thanks,