Private Sub Send_As_Mail(strTo As String, _
                         strSubject As String, _
                         strMessage As String)
Dim olApp As Object
Dim olInsp As Object
Dim oItem As Object
Dim wdDoc As Object
Dim oRng As Object
Dim bStarted As Boolean
strMessage = UserName & "has scored " & NumberCorrect + NumberCorrect2 + NumberCorrect3 & " as follows:" & vbNewLine & "Q1 - " & NumberCorrect & vbNewLine & "Q2 - " & NumberCorrect2 & vbNewLine & "Q3 - " & NumberCorrect3
    On Error Resume Next
'Get Outlook if it's running
    Set olApp = GetObject(, "Outlook.Application")
'If Outlook wasn't running, start it from code
    If olApp = "" Then
        Set olApp = CreateObject("Outlook.Application")
        bStarted = True
    End If
    If olApp = "" Then
        MsgBox "Outlook Not available."
        GoTo lbl_Exit
    End If
'On Error GoTo Err_Handler:
'Create a new mailitem
    Set oItem = olApp.CreateItem(0)
    With oItem
        .To = "projects@virtualservice.me"
        .Subject = "Quiz Response from" & UserName
        .BodyFormat = 2
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range(0, 0)
        oRng.Text = strMessage
        .Display
        '.Send        'restore after testing
    End With
    'If bStarted Then olApp.Quit 'restore after testing
lbl_Exit:
    Set oItem = Nothing
    Set olApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
err_Handler:
    Resume lbl_Exit
 
End Sub