Deleting VBA Code Locks PowerPoint

[swsouth]

Hello, first time to this forum. I've got a PowerPoint that creates a customized version of itself and saves it as a slideshow. I then need to strip the VBA from the slideshow as a security precaution and also to remove the "Enable Macros" warning that is seen when the file is opened. I've successfully removed the macros with the code below, but for some reason it only works on my system. I've tested on several other systems and they lock-up when trying to strip the code. One big difference is I am running dual-procs 3GHz with 2GB of RAM. All other systems tested were single-proc at various lesser speeds and amounts of RAM. Could this be the reason for lock-up? If you would be so kind to review the code and make any suggestions for making it work on other computers it would be so greatly appreciated. In a nutshell, I need to open the slideshow from the parent PowerPoint, strip the code from the slideshow, save the revised version, close it and return to the parent and continue with operations where I left off in the code of the parent PowerPoint. Please keep in mind I'm very new to VBA, but here's what I've got thus far:

Public Sub DeleteAllCode()

Dim sCustName As String
Dim ppApp As Application
Dim ppPres As Presentation
Dim x As Integer

Set ppApp = GetObject(, "PowerPoint.Application")
If Err.Number <> 0 Then 'PowerPoint isn't already running
Set ppApp = New PowerPoint.Application
End If
On Error Goto 0

sCustName = removeSpaces(TextBox2.Value)

Set ppPres = ppApp.Presentations.Open(CurDir & "\" & sCustName & "\BuyvsRent_" & sCustName & ".pps")


On Error Resume Next
With ActivePresentation.VBProject
For x = .VBComponents.Count To 1 Step -1
.VBComponents.Remove .VBComponents(x)
Next x
For x = .VBComponents.Count To 1 Step -1
.VBComponents(x).CodeModule.DeleteLines _
1, .VBComponents(x).CodeModule.CountOfLines
Next x
End With
On Error Goto 0

ppApp.ActivePresentation.Save

ppApp.ActivePresentation.Close

End Sub

Any help would be greatly appreciated.

Thanks,

swsouth

 

[PHV]

You may try this:
With [!]ppApp.[/!]ActivePresentation.VBProject
...
[!]Set ppPres = Nothing[/!]
End Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886