Excel VBA - Sending email

[dweber5]

Hello, I am trying to do the following...
I have a VBA macro script in my Excel spreadsheet that pulls an email
address and a school name for my company and then will send an email
to our survey software with the email address and the appropriate
survey code in order for an automated helpdesk survey to be sent to
the student for the appropriate school. I got most of the code off
the internet and have made edits that I needed to make. The only
issue is that when I send the email to the survey software it will
only work if the email is send in PLAIN TEXT. Unfortunately it will
send it whichever format the email program is currently set as. I
have been searching for a code to change this but have been
unsuccessful. Is there code I can add to force the email to send as
plain text? Here is the code I have so far...

Sub SendEMail()
Dim StEmail As String, Subj As String, Email As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
Dim SurvCode As String

For r = 2 To 3 'data in rows 2-4
' Decide which school survey to pull
If Cells(r, 3) = "Strayer" Then
SurvCode = "CFW8F296FEAF3D8N"
End If
If Cells(r, 3) = "Corinthian" Then
SurvCode = "PMFV7BQG82NUPVHB"
End If

' Email address to send to SurveyMethods
Email = "(e-mail address removed)"

' Get the email address
StEmail = Cells(r, 2)

' Message subject
Subj = "Remoteactivation"

' Compose the message
Msg = ""
Msg = Msg & "[Loginid][email protected]" & vbCrLf
Msg = Msg & "[Surveycode]" & SurvCode & vbCrLf
Msg = Msg & "[SendtoStart]" & vbCrLf
Msg = Msg & StEmail & ";" & vbCrLf
Msg = Msg & "[SendtoEnd]" & vbCrLf
Msg = Msg & "[Categoryvalue1]" & vbCrLf & "[Categoryvalue2]" &
vbCrLf
Msg = Msg & "[Categoryvalue3]" & vbCrLf & "[Categoryvalue4]" &
vbCrLf
Msg = Msg & "[Categoryvalue5]"

' 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"
Next r
End Sub