Vb code to copy active powerpoint in slide show and automatically send to email

Sub PrintScreenAndEmail()
    Dim tempFilePath As String
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim activeSlide As Slide
    
    'Get active slide
    Set activeSlide = ActivePresentation.SlideShowWindow.View.Slide
    
    'Save print screen as temporary file
    tempFilePath = CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2).Path & "\PrintScreen.jpg"
    activeSlide.Export tempFilePath, "JPG"
    
    'Create new email
    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)
    
    'Add screenshot to email
    outlookMail.Attachments.Add tempFilePath
    
    'Add recipients and subject
    outlookMail.To = "john.doe@example.com; jane.doe@example.com"
    outlookMail.Cc = "peter.doe@example.com; mary.doe@example.com"
    outlookMail.Bcc = "secret.recipient@example.com; confidential.recipient@example.com"
    outlookMail.Subject = "Print Screen of PowerPoint Slide"
    
    'Add message to email body
    outlookMail.Body = "Please see the attached screenshot of the PowerPoint slide."
    
    'Send email
    outlookMail.Send
    
    'Delete temporary file
    Kill tempFilePath
    
    'Close presentation
    ActivePresentation.Close
    
    'Show message box
    MsgBox "Thank you for taking the survey.", vbInformation + vbOKOnly, "Survey Completed"
End Sub