Macro attached to Ribbon works once, then no longer

[PPoinTer]

I'm looking to create a few additions / changes to my PPT toolbars using a few custom macros. I have successfully built a few of these macros, as well as learned how to place these macros in existing tabs using the Custom UI Editor for MS office. However, one of these macros in particular is causing an unusual issue that I can't quite figure out.
When opening a file, the all the macros work. However, after executing a 'send specific slides' macro that I built, all the custom macros no longer work after this. I have tried a number of different changes to this macro, as well as removing all the other macros, but none of this has worked.

Couple other quick notes:

• I am currently using Office 2013
• I'm currently working in the file as a pptm, but plan on converting to an add-in once this bug is fixed
• When you save the file as a new name, the macro then works again for one execution

Below is the language from the macro as well as the Custom UI editor.

Option Explicit

Sub AttachSelection(Optional control As IRibbonControl)
Dim oPres           As Presentation
Dim oSlide          As Slide
Dim sTempFile       As String
Dim sFileName       As String
Dim tFileName       As String
Dim iCounter        As Integer
Dim oMessage        As Variant
Dim olMailItem      As Variant
Dim sFilePath       As String
Dim oOutlookApp     As Object
Dim Invalids        As Variant
Dim e               As Variant
Dim strTemp         As String
Dim strFileName     As String
Dim CleanFileName   As String

'If saved not up to date then save
If ActivePresentation.Saved = False Then ActivePresentation.Save

'Create filename
sFileName = ActivePresentation.Name
Invalids = Array("?", "*", ":", "|", "<", ">", "[", "]", "", "/", ".pptx", ".pptm", ".ppt")
strTemp = sFileName

For Each e In Invalids
    strTemp = Replace(strTemp, e, "")
Next
CleanFileName = strTemp

tFileName = CleanFileName & "_temp.pptx"

'remove old tags
For Each oSlide In ActivePresentation.Slides
oSlide.Tags.Delete ("SEL")
Next oSlide

'add selected tag
For Each oSlide In ActiveWindow.Selection.SlideRange
oSlide.Tags.Add "SEL", "YES"
Next oSlide

ActivePresentation.SaveCopyAs (Environ("TEMP") & "\" & tFileName)
Set oPres = Presentations.Open(Environ("TEMP") & "\" & tFileName)
sTempFile = oPres.FullName
For iCounter = oPres.Slides.Count To 1 Step -1
If oPres.Slides(iCounter).Tags("SEL") <> "YES" Then oPres.Slides(iCounter).Delete
Next iCounter

'Attaches temp file to Outlook email
'If Outlook is not open this takes a while - may want to consider opening a new instance of outlook for this?
Set oOutlookApp = GetObject(Class:="Outlook.application")
Set oMessage = oOutlookApp.CreateItem(olMailItem)
With oMessage
.Attachments.Add sTempFile
.Subject = sFileName
.Display
End With

oPres.Saved = True
oPres.Close

''Tried including the bottom items to see if it would fix it.  Did not.
'Set oSlide = Nothing
'Set oPres = Nothing
'Set oMessage = Nothing
'Set olMailItem = Nothing
'Set oPres = Nothing
'Set oOutlookApp = Nothing
'Set Invalids = Nothing
'Set e = Nothing

'Delete temp file
Kill sTempFile

End Sub

<!-- Creates Custom Tab -->

<customUI xmlns="ht........m/office/2009/07/customui"> 
<ribbon startFromScratch="false">

<tabs>

<tab idMso="TabHome">

<group id="CustomGroup" label="Send Slides" insertAfterMso="Editing">

<button id="AttachSelection" label="Attach Selection" onAction="AttachSelection" imageMso="ManageReplies" screentip="Attach Selected Slides" supertip="Attaches the selected slides to an email" keytip="AS"/>

</group>
</tab>
</tabs>
</ribbon>
</customUI>

Note, I previously attached this same question to stack overflow but still haven't reached a solve. The code above is for a new simplified file, with no other macros included and no other code. What you see is what you get. Any help you can provide would be much appreciated, this problem is driving me a bit nuts!

[werafa]

Am going to guess here as I am still something of a novice at PPT VBA -

When you 'save as', does the presentation object change? I'm using the logic that your code is sound on the first run, but something changes that breaks it on the second - can only think of a change to your objects that is not being picked up by the code, and have seen variable results when working with 'save as' files. Try being super explicit in these definitions - and make sure you don't have original and 'save as' presentation objects in parallel

setting objects to nothing is wise housekeeping - keep this in, it will cause no harm at minimum, and may stop some memory leaks and crashes.

[PPoinTer]

Thanks for the quick response!

I'm sure I'm more of a novice than you, so you may have to help me out a bit further by what you mean. I though I understood what you meant by the confusion so I tried to make some small changes to make sure that was cleared. The changes I made were as follows:
- Reinstated all the objects to nothing at the end
- Moved the Set oSlide = Nothing to just after that object is no longer needed
- Moved the Set oPres = Nothing to just after the oPres.close command

I moved these because I thought there may have possibly been some confusion as to which presentation those objects applied to. Unfortunately, this didn't do the trick. Is it possible that there's some sort of issue with the fact that the code is trying to get pulled over to the copied file as well and isn't able to?

I'm confused about this, because no errors come up during the process of running the macro once, but you can't even begin to start the macro a second time... very confused.

[Bob Phillips]

Two suggestions.

Post a link to the StackOverflow, and post your document, it will make life simpler.

[PPoinTer]

Unfortunately, it doesn't seem to allow me to attached the link. If you type this into the search bar for Stackoverflow, it should come up. "issue-with-creating-custom-toolbar-with-macros-for-ppt"

Cheers

[John Wilson]

I would never save a copy that will contain the XML ribbon code. When you reopen the temp file there are two copies of the ribbon code and this will cause problems.

As a ppam it should work fine but I would check for the outlook app being found and created if not.

If you are distributing this you should use the 2007 namespace as the 2010 one you use will not work in 2007 whilst the 2007 one will work in 2007 - 2013

 On Error Resume Next
    Set oOutlookApp = GetObject(Class:="Outlook.application")
    If oOutlookApp Is Nothing Then Set oOutlookApp = CreateObject(Class:="Outlook.Application")

[PPoinTer]

John,

Thanks for your thoughts and apologies for the delay. Unfortunately, my normal work interfered for a while.

So I've figured out how to get this module to work, though I'm pretty sure it is far from the cleanest way to do this. The code is below, but I would be super appreciative if people could help with just a few questions.

1. The only way I found to get this to work is to delete the original file, open up the copy, and then reopen the original file. It's not a big deal for small files, but would be quite a time nuissance for bigger PPT files. Is there anyway to work around this so as to keep the original file, and possibly not even create a new file?
2. If there isn't a way around the above response, is there an easy way to stop screen updating like in Excel?
3. Are there any other things people would suggest to clean this up?

Option Explicit

Sub AttachSelection(ByVal control As IRibbonControl)
Dim oPres           As Presentation
Dim oSlide          As Slide
Dim sTempFile       As String
Dim sFileName       As String
Dim tFileName       As String
Dim iCounter        As Integer
Dim oMessage        As Variant
Dim olMailItem      As Variant
Dim sFilePath       As String
Dim oOutlookApp     As Object
Dim Invalids        As Variant
Dim e               As Variant
Dim strTemp         As String
Dim strFileName     As String
Dim CleanFileName   As String
Dim FilePath        As String


'If saved not up to date then save
If ActivePresentation.Saved = False Then ActivePresentation.Save


FilePath = ActivePresentation.FullName


'Create filename
sFileName = ActivePresentation.Name
Invalids = Array("?", "*", ":", "|", "<", ">", "[", "]", "", "/", ".pptx", ".pptm", ".ppt")
strTemp = sFileName


For Each e In Invalids
    strTemp = Replace(strTemp, e, "")
Next
CleanFileName = strTemp


tFileName = CleanFileName & "_temp.pptx"


'remove old tags
For Each oSlide In ActivePresentation.Slides
oSlide.Tags.Delete ("SEL")
Next oSlide


'add selected tag
For Each oSlide In ActiveWindow.Selection.SlideRange
oSlide.Tags.Add "SEL", "YES"
Next oSlide


Set oSlide = Nothing


ActivePresentation.SaveCopyAs (Environ("TEMP") & "\" & tFileName)
'NS
ActivePresentation.Close


Set oPres = Presentations.Open(Environ("TEMP") & "\" & tFileName)
sTempFile = oPres.FullName


For iCounter = oPres.Slides.Count To 1 Step -1
    If oPres.Slides(iCounter).Tags("SEL") <> "YES" Then oPres.Slides(iCounter).Delete
Next iCounter


oPres.Save
oPres.Close


Set oPres = Nothing


Presentations.Open (FilePath)


'Attaches temp file to Outlook email
'If Outlook is not open this takes a while - may want to consider opening a new instance of outlook for this?


On Error Resume Next
Set oOutlookApp = GetObject(Class:="Outlook.application")
If oOutlookApp Is Nothing Then Set oOutlookApp = CreateObject(Class:="Outlook.Application")


Set oMessage = oOutlookApp.CreateItem(olMailItem)
With oMessage
.Attachments.Add sTempFile
.Subject = sFileName
.Display
End With


'Close out objects
Set oMessage = Nothing
Set olMailItem = Nothing
Set oOutlookApp = Nothing
Set Invalids = Nothing
Set e = Nothing


'Delete temp file
Kill sTempFile


End Sub

[John Wilson]

If you just want to retain the selected slides you could maybe try

ActiveWindow.Selection.SlideRange.Cut
ActivePresentation.Slides.Range.Delete
ActivePresentation.Slides.Paste

Obviously this is destructive so be sure you dont save over the original!

You can send the message (with less control but easier) with

Application.CommandBars.ExecuteMso("FileSendAsAttachment")