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

[Ecniv]

use code tags (above the editting window there is VBCode.. click this, press s and return. You should get {VBCODE]s{/VBCODE] (where { is [) This puts the code in a nicer to read format.

As to your question - your code doesn't appear to copy the file you are in.

Public Sub DeleteAllCode() 

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

'if you get the object fine
'if not, then create the object (or in this case instance a new one)
Set ppApp = GetObject(, "PowerPoint.Application") 
If Err.Number <> 0 Then 'PowerPoint isn't already running
    Set ppApp = New PowerPoint.Application 
End If 

'pointless - no error handling above
On Error Goto 0 

'no idea? removing spaces?
sCustName = removeSpaces(TextBox2.Value) 

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


'if you get an error- ignore it!
On Error Resume Next 

'loop and remove code modules
' aren`t you in these to run this code?
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 

'pointless
On Error Goto 0 

'save pres
ppApp.ActivePresentation.Save 

'closes pres
ppApp.ActivePresentation.Close 

End Sub

Looks ok code wise. So where does it crash?
Is it on the removal of code?
If so then copy the pps first (filecopy I think the function is), then open it (perhaps check options to open? see if you can stop macros etc running).
Then remove your code.
Do the rest as you have then set your reference to nothing to fully clear.