generate email longer than 255 characters

[brenton]

I have been browsing solutions for this problem but cant figure it out. This code limits the string so the email cuts off the complete text past a certain length. Whats the best workaround for the 255 character limit? Can I create an array http://support.microsoft.com/kb/105416 ?

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 SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String, Msg2 As String

    Email = Range("Email")
        
    Subj = "Writet subject here"
    Contact = Range("ExecutiveContact2")
    Contact2 = Range("Contact2")
    Contact3 = Range("Contact3")
    ClientName = Range("ClientName1")
    SimilarCompanies = Range("SimilarCompanies")
    
    
    'Content--------------------------------------------------------------
    
    Msg = ""
    Msg = Msg & "Dear " & Contact & "," _
    & vbCrLf & vbCrLf & _
    "I am writing to you, to find out the most appropriate person to talk to regarding scheduling a twenty minute phone appointment to discuss how we can help " & _
    ClientName & "." & vbCrLf & vbCrLf & _
    "bunch more text that eventually gets cut off"
    
    '------------------------------------------------------------------------------
    
    '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 "%s"
End Sub