I have a script which attach only selected files in Outlook, but when the file is not saved it gives error no 5.
I want a msg popup "Please save your file" instead of coming error msg, below are my script
Sub SendSDDesignteam()
Dim objActivePresetation As Presentation
Dim objSlide As Slide
Dim n As Long
Dim strName As String
Dim strTempPresetation As String
Dim objTempPresetation As Presentation
Dim objOutlookApp As Object
Dim objMail As Object
Set objActivePresetation = ActivePresentation
For Each objSlide In objActivePresetation.Slides
objSlide.Tags.Delete ("Selected")
Next
'Add a tag "Selected" to the selected slides
For n = 1 To ActiveWindow.Selection.SlideRange.Count
ActiveWindow.Selection.SlideRange(n).Tags.Add "Selected", "YES"
Next n
strName = objActivePresetation.Name
strName = Left(strName, InStrRev(strName, ".") - 1)
strTempPresetation = Environ("TEMP") & "\" & strName & ".pptx"
'Copy the active presentation to a temp presentation
objActivePresetation.SaveCopyAs strTempPresetation
Set objTempPresetation = Presentations.Open(strTempPresetation)
'Remove the untagged slides
For n = objTempPresetation.Slides.Count To 1 Step -1
If objTempPresetation.Slides(n).Tags("Selected") <> "YES" Then
objTempPresetation.Slides(n).Delete
End If
Next n
objTempPresetation.Save
objTempPresetation.Close
'Attach the temp presentation to a new email
Set objOutlookApp = CreateObject("Outlook.Application")
Set objMail = objOutlookApp.CreateItem(olMailItem)
'Change the email details as per your needs
With objMail
.To = "abc@johndoe.com"
.Subject = "Formatting/Designing Help"
.Body = "Hi Team," & vbCr & vbCr & vbTab & "Need this by Date: DD/MM/YYYY, Time : 00:00, Client : XYZ, Comment : NA."
.Attachments.Add strTempPresetation
.Display
End With
End Sub
It will be great help if you can help me in this.
Thanks in advance
Error occurs here.
strName = Left(strName, InStrRev(strName, ".") - 1)
When the file is not saved, strName does not contain ".". InStrRev(strName, ".") - 1 is equal to -1. This generates an Error. So you can check if the error occurs and display the message like this.
On Error Resume Next 'Begin ignoring errors.
strName = Left(strName, InStrRev(strName, ".") - 1)
If Err Then
MsgBox "Please save your file", vbCritical, "Error"
Exit Sub
End If
On Error Goto 0 'Stop ignoring errors.
But you'd better check if the file is saved at the beginning of the procedure like this.
Set objActivePresetation = ActivePresentation
'Check if the file is saved.
If objActivePresetation.Saved = False Then
MsgBox "Please save your file", vbCritical, "Error"
Exit Sub
End If