View Single Post
 
Old 06-03-2015, 05:21 AM
Ochimus Ochimus is offline Windows 8 Office 2013
Novice
 
Join Date: Jun 2015
Location: England
Posts: 6
Ochimus is on a distinguished road
Default

Graham,

Many thanks for the prompt response.

Unfortunately it must be me, because after I added the Code and ran the presentation, it "hung" at the last slide. Never bought up the Score Text box however many times I clicked it, and Outlook never opened.

I am totally unfamiliar with Outlook, having always used Lotus Notes and now Webmail, so as the first step, can you advise whether I have entered the delivery address, subject line and "text" in the body correctly?

Is there is some way I can attach the actual Presentation? Would probably make everything immeasurably clearer!

Code:
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
Reply With Quote