J
Jeremy Gollehon
An error is raised if I try to send quotes to an email body throught code.
I've worked around this by replacing the quotes with an apostrophe, but I
was hoping someone out there knows how to pass the quotes through.
Thanks to Ron Debruin for most of the code below.
http://www.rondebruin.nl/sendmail.htm#selection
-Jeremy
-------------------------------------------------------------------------
Sub PrepareTheEmail()
Dim sRecipient As String
Dim sSubject As String
Dim sMsg As String
Dim sMail As String
Const q As String = """"
Const apos As String = "'"
With ActiveCell
sRecipient = .Offset(0, 8)
sSubject = "Regarding: " & .Offset(0, 3)
sMsg = .Offset(0, 7) & "," & vbNewLine & vbNewLine
sMsg = sMsg & "Regarding:" & vbNewLine
sMsg = sMsg & .Offset(0, 3) & vbNewLine & vbNewLine
sMsg = sMsg & "Details: " & vbNewLine
sMsg = sMsg & .Offset(0, 6) & vbNewLine & vbNewLine
sMsg = sMsg & "Solution/Comments:" & vbNewLine
sMsg = sMsg & .Offset(0, 9) & vbNewLine & vbNewLine
sMsg = sMsg & .Offset(0, 10)
End With
'Format message to work with Mail program by replacing
'spaces with %20, returns with %0D%0A, quotes with apostrophe
With Application.WorksheetFunction
sSubject = .Substitute(sSubject, " ", "%20")
sMsg = .Substitute(sMsg, " ", "%20")
sMsg = .Substitute(sMsg, vbNewLine, "%0D%0A")
sMsg = .Substitute(sMsg, vbLf, "%0D%0A")
sMsg = .Substitute(sMsg, q, apos)
End With
sMail = "mailto:" & sRecipient & _
"?subject=" & sSubject & _
"&body=" & sMsg
ThisWorkbook.FollowHyperlink sMail
End Sub
-------------------------------------------------------------------------
I've worked around this by replacing the quotes with an apostrophe, but I
was hoping someone out there knows how to pass the quotes through.
Thanks to Ron Debruin for most of the code below.
http://www.rondebruin.nl/sendmail.htm#selection
-Jeremy
-------------------------------------------------------------------------
Sub PrepareTheEmail()
Dim sRecipient As String
Dim sSubject As String
Dim sMsg As String
Dim sMail As String
Const q As String = """"
Const apos As String = "'"
With ActiveCell
sRecipient = .Offset(0, 8)
sSubject = "Regarding: " & .Offset(0, 3)
sMsg = .Offset(0, 7) & "," & vbNewLine & vbNewLine
sMsg = sMsg & "Regarding:" & vbNewLine
sMsg = sMsg & .Offset(0, 3) & vbNewLine & vbNewLine
sMsg = sMsg & "Details: " & vbNewLine
sMsg = sMsg & .Offset(0, 6) & vbNewLine & vbNewLine
sMsg = sMsg & "Solution/Comments:" & vbNewLine
sMsg = sMsg & .Offset(0, 9) & vbNewLine & vbNewLine
sMsg = sMsg & .Offset(0, 10)
End With
'Format message to work with Mail program by replacing
'spaces with %20, returns with %0D%0A, quotes with apostrophe
With Application.WorksheetFunction
sSubject = .Substitute(sSubject, " ", "%20")
sMsg = .Substitute(sMsg, " ", "%20")
sMsg = .Substitute(sMsg, vbNewLine, "%0D%0A")
sMsg = .Substitute(sMsg, vbLf, "%0D%0A")
sMsg = .Substitute(sMsg, q, apos)
End With
sMail = "mailto:" & sRecipient & _
"?subject=" & sSubject & _
"&body=" & sMsg
ThisWorkbook.FollowHyperlink sMail
End Sub
-------------------------------------------------------------------------