Opening saved excel document and resetting powerpoint to first slide in presentation mode using VBA

[Excel Novice Darren]

Hi all ,

I'm using Windows 7 and Office 2010

I am brand new to VBA I have used this site to find code for certain applications and up until now I have always found an answer.

I am creating an Company Induction on Powerpoint. When the Inductee gets to the end of the induction I have used an action button linked to an excel document where they fill in their details. I have then used a VBA code found on here to send the excel document to an email recipient using Lotus Notes and automatically close Excell.

To finish off I would like to add code to go back to the first slide in the induction powerpoint presentation (which should be open) in presentation mode, however I would also like to open the powerpoint at the first slide in presentation mode if for some reason it has been closed.

I have included my entire code for the excel document and as you will see I get the powerpoint to open in presentation mode on the first slide but once powerpoint is open when I run this code again it goes back to the final slide not the first slide.

Hope this makes sense?

Option Explicit

Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "P:\Toton Business Improvements\Contractor Management\Full Induction\TEMP\"
Const vaMsg As Variant = "Please save this document in a folder identified with the company name and use the surname followed by forename as the document name." & vbCrLf & _
"Kind regards," & vbCrLf & _
"Induction System"
Const vaCopyTo As Variant = "email address"
Sub Send_Active_Sheet1()

Dim stFileName As String
Dim vaRecipients As Variant

Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String

'Copy the active sheet to a new temporarily workbook.
With ActiveSheet
.Copy
stFileName = "New Inductee for processing"
End With

stAttachment = stPath & "New inductee for processing.xlsm"

MsgBox "Select YES when asked if you would like to replace the existing document", vbInformation

'Save and close the temporary workbook.
With ActiveWorkbook
ChDir "P:\Toton Business Improvements\Contractor Management\Full Induction\TEMP\"
ActiveWorkbook.SaveAs Filename:= _
"P:\Toton Business Improvements\Contractor Management\Full Induction\TEMP\New Inductee for processing.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
End With

'Create the list of recipients.
'vaRecipients = VBA.Array("email address", "email address")

'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)

'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With

'Delete the temporarily workbook.

'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

MsgBox "The e-mail has successfully been created and distributed", vbInformation


Dim myPPAppObj As PowerPoint.Presentation
Set myPPAppObj = GetObject("P:\Toton Business Improvements\Contractor Management\Company.pptm")
'Add your path and file in above!
myPPAppObj.SlideShowSettings.Run

ActiveWorkbook.Close SaveChanges:=False
End Sub

Can anyone please help!!