Create e-mail copying Powerpoint textbox and send it automatically

Ochimus · #1 06-03-2015, 02:51 AM

I need to create an e-mail of the text in a PowerPoint textbox, and send it automatically to someone.

I created a Quiz in PowerPoint with a Macro that classes each possible answer to each Question as a "Shape", Each shape is assigned a value ("0", "1" or "2").,

At the end of the Quiz it puts those numbers in a textbox showing the User what his score was for each question. The Code registering and then showing the "right" answers is as follow:.

Code:

 
Sub Correct()
If SlideShowWindows(1).View.Slide.SlideIndex = 2 Then
NumberCorrect = NumberCorrect + 1
ElseIf SlideShowWindows(1).View.Slide.SlideIndex = 3 Then
NumberCorrect2 = NumberCorrect2 + 1
ElseIf SlideShowWindows(1).View.Slide.SlideIndex = 4 Then
NumberCorrect3 = NumberCorrect3 + 1
End If
ActivePresentation.SlideShowWindow.View.Next
End Sub
 
Sub results()
 
Dim ANSWERBOX As Object

Set tb = ActivePresentation.Slides(5).Shapes("ANSWERBOX") 
tb.Visible = True
tb.TextFrame2.TextRange.Characters.Text = UserName & ", You scored " & NumberCorrect + NumberCorrect2 + NumberCorrect3 & " as follows:" & vbNewLine & "Q1 - " & NumberCorrect & vbNewLine & "Q2 - " & NumberCorrect2 & vbNewLine & "Q3 - " & NumberCorrect3

End Sub

I need to send that final "Text" as an e-mail automatically to the Quiz controllers, so they can see and table the answers given by each User.

All suggestions and solutions accepted gratefully

Ochimus

gmayor · #2 06-03-2015, 04:53 AM

Calling Outlook to send your message is fairly straightforward e.g. call the following sub from your macro to create the message and supply it with the recipient address, the Subject text and the final 'Text' as the message body.

Code:

Option Explicit


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

    On Error Resume Next
    'Get Outlook if it's running
    Set olApp = GetObject(, "Outlook.Application")
    '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 = strTo
        .Subject = strSubject
        .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

Ochimus · #3 06-03-2015, 05:21 AM

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

gmayor · #4 06-03-2015, 06:13 AM

The problem isn't that you are unfamiliar with Outlook, (you don't need to know anything about Outlook) but that you are unfamiliar with calling a procedure from your macro.

You don't need to make any changes to the Code I posted. Instead you should call it from your original macro that has the data you want to send. Put the macro in the same folder as your original macro that reads the text box(es) etc and then add a line to the original macro to write the string to the sub e.g.

Code:

Dim strMessage As String
    strMessage = UserName & "has scored " & NumberCorrect + NumberCorrect2 + NumberCorrect3 & " as follows:" & vbNewLine & "Q1 - " & NumberCorrect & vbNewLine & "Q2 - " & NumberCorrect2 & vbNewLine & "Q3 - " & NumberCorrect3
    
     Send_As_Mail strTo:="projects@virtualservice.me", _
                 strSubject:="Quiz Response from" & UserName, _
                 strMessage:=strMessage

You can use 'Go Advanced' to attach your presentation, or if it exceeds the filesize limitation, upload the file somewhere e.g. dropbox or onedrive and post the link.

Ochimus · #5 06-03-2015, 06:56 AM

Graham,

Thank you for explaining how to attach the file, which I have now done.

As you can see from the Code, I had posted your mail Code in the same module as the others and I had "called" it within the "Results" module that populates and shows the Text box I need to e-mail.

Life would be much easier if MS gave PPT the same "Debug" feature as Excel, which at least gives an indication of what is going wrong "behind the scenes". But as they stripped out the "Code as you go" feature in 2007 I should not have been surprised.

Hopefully you can now find the flaw and enable this to work.

Appreciate the time you have put into this.

gmayor · #6 06-03-2015, 08:00 AM

The macro works as I said if you follow my instructions. Restore the macro from my original message in place of the one you altered and change the following macro as follows:

Code:

Sub results()
Dim strMessage As String
Dim ANSWERBOX As Object

Set tb = ActivePresentation.Slides(5).Shapes("ANSWERBOX")        '## Update this to use the correct name or index of the shapes collection ##'

    tb.Visible = True

    tb.TextFrame2.TextRange.Characters.Text = UserName & ", You scored " & NumberCorrect + NumberCorrect2 + NumberCorrect3 & " as follows:" & vbNewLine & "Q1 - " & NumberCorrect & vbNewLine & "Q2 - " & NumberCorrect2 & vbNewLine & "Q3 - " & NumberCorrect3

    strMessage = UserName & "has scored " & NumberCorrect + NumberCorrect2 + NumberCorrect3 & " as follows:" & vbNewLine & "Q1 - " & NumberCorrect & vbNewLine & "Q2 - " & NumberCorrect2 & vbNewLine & "Q3 - " & NumberCorrect3

    Send_As_Mail strTo:="projects@virtualservice.me", _
                 strSubject:="Quiz Response from" & UserName, _
                 strMessage:=strMessage

End Sub

If the body text of the message doesn't populate, make sure Outook is running before you begin.

Ochimus · #7 06-03-2015, 08:41 AM

Graham,

Thanks for the patience.

Took me a few seconds to realise the "Send" had been commented out, and left me having to click it manually,

Only problem I'm left with is that it relies on the person filling in the questionnaire having Outlook both installed and open on their machine for the Macro to work.

As this has to be a completely automatic process. I'm not quite sure how or if it is possible to work round those two points? Any suggestion welcomed

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro for Copying Charts to Powerpoint	bremen22	Excel Programming	1	10-01-2013 03:27 PM
PowerPoint 2007- Reapply Master to Notes Page but Not to the Text within the Textbox/	mejasmine	PowerPoint	0	01-26-2012 07:39 AM
PowerPoint 2007 Textbox Lock / Form Issues	LTechie12	PowerPoint	0	01-08-2012 02:08 PM
How to Start from 1. automatically after copying/pasting a Numbered Bullet or Table	drlili	Word	2	07-25-2011 09:38 AM
Copying data from one cell to another automatically	mrphilk	Excel	4	06-10-2010 11:52 PM