Annielebo
07-13-2008, 10:21 PM
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
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