#1
|
|||
|
|||
Create e-mail copying Powerpoint textbox and send it automatically
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 |
#2
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
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 |
#4
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
|||
|
|||
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. |
#6
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#7
|
|||
|
|||
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 |
Tags |
powerpoint macro, textboxes, vba code |
Thread Tools | |
Display Modes | |
|
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 |