Self destructing code

[Guest]

Here's the code I need to run:

*****
Sub renamer()

Dim mySht As Worksheet
'Dim VBComp As VBComponent

Application.DisplayAlerts = False
TabName = Range("A1").Value
ActiveSheet.Name = TabName
ActiveSheet.SaveAs (TabName)

For Each mySht In ActiveWorkbook.Worksheets
If mySht.Name <> TabName Then mySht.Delete
Next mySht
Application.DisplayAlerts = True

Set VBComp = ThisWorkbook.VBProject.VBComponents("Module1")
ThisWorkbook.VBProject.VBComponents.Remove VBComp

End Sub
*****

The idea of this code is to rename, clean up, and save a workbook then
delete the VB module that called it. The end result/output file can then be
passed on without the end user panicking over whether or not to access macros
etc etc. Problem is, the code does everything it's supposed to up to the
point of renaming and saving, but then it deletes itself. So, it saves the
copy *with* code where I want a copy saved *without* code. Of course, if I
re-arrange the lines to make the macro delete the code before saving, it
won't work...

Effectively the snake eats its own tail ;-) Does anyone have a smart way to
make the code hold off module deletion, or even better to delete the code
from the new file and then save - or am I quite simply (as usual) asking the
impossible?

 

[keepITcool]

use savecopyas
then open the copy
remove stuff from there
save the copy
close yourself.





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Aaron Howe wrote :

 

[Andibevan]

Aaron,

If / When you get your code to work - any chance you could post it back here
as I would find it useful and it would save me having to work it out myself.

Ta

Andi


use savecopyas
then open the copy
remove stuff from there
save the copy
close yourself.





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Aaron Howe wrote :

 

[keepITcool]

a quick attempt:

be carefull to save an extra copy..
as this is a runonce code..

Sub CloseAndSaveSansCode()
Dim wkb As Workbook
Dim vbc As VBComponent

ThisWorkbook.SaveCopyAs Replace(ThisWorkbook.FullName, ".xls", ".tmp")
Set wkb = Workbooks.Open(Replace(ThisWorkbook.FullName, ".xls", ".tmp"))
For Each vbc In wkb.VBProject.VBComponents
If vbc.Type = vbext_ct_StdModule Then
wkb.VBProject.VBComponents.Remove vbc
Else
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End If
Next
wkb.Close True

Application.DisplayAlerts = False
ThisWorkbook.ChangeFileAccess (xlReadOnly)
Application.DisplayAlerts = True

Kill ThisWorkbook.Name
Name Replace(ThisWorkbook.FullName, ".xls", ".tmp") As _
ThisWorkbook.FullName
ThisWorkbook.Close
End Sub




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Andibevan wrote :

 

[Tom Ogilvy]

KeepItCool has provided the pseudo code. The bottom line is that you can't
have code save the workbook after you delete the code and expect it to not
contain the code being deleted. Code that is deleted by code is not deleted
until the code completes.

The alternative would be to have the workbook create a dummy workbook and
put code in that workbook, then call that code using Application.Ontime.
The code in the new workbook would then delete the code in the original
workbook and save the original workbook without code. It would then close
without saving. This might have to be done with two separate procedures in
the new workbook. The first procedure removes the code and then uses
ontime to start the second procedure which saves the original, and closes
the new workbook.

Untested, but should work.

 

[Guest]

Andi,

I think I have it. It's not pretty, but it does the job. I've included the
rem'd out lines to show me where my thought process went. Here's what I have:
Sub renamer()

Dim mySht As Worksheet
'Dim VBComp As VBComponent

Application.DisplayAlerts = False
TabName = Range("A1").Value

'ActiveSheet.SaveAs (TabName)
'ActiveWorkbook.SaveCopyAs (Tabname)

Workbooks.Add
ActiveWorkbook.SaveAs ("Temp.xls")
Windows("Quotes.xls").Activate

Sheets("Quote").Select
Sheets("Quote").Copy After:=Workbooks("Temp.xls").Sheets(3)
ActiveSheet.Name = TabName

For Each mySht In ActiveWorkbook.Worksheets
If mySht.Name <> TabName Then mySht.Delete
Next mySht
Application.DisplayAlerts = True

ActiveWorkbook.SaveAs (TabName)
ActiveWorkbook.Close

If Len(Dir("Temp.xls")) > 0 Then
Kill "Temp.xls"
End If

'Set VBComp = ThisWorkbook.VBProject.VBComponents("Module1")
'ThisWorkbook.VBProject.VBComponents.Remove VBComp

End Sub
So, to explain what this does... the file gets the "key" from a field - in
this case A1 but it can easily be changed and I will most likely amalgamate
many lines into one for this. It then creates a new Excel sheet and saves it
with a temporary name - because filepaths are relative to users I did not use
one here, so Excel will go with the user's default filepath. It then
activates the original sheet the macro was called from (here, "Quotes").

The sheet needed in "Quotes" is then copied to the temporary file,
eliminating the need to remove the VBA code from the final worksheet as it
isn't linked to the original worksheet in the first place. The sheet is
renamed, and all unnecessary sheets are removed (handy if the user has
altered their default New Sheets in Workbook value). The temporary workbook
is given the proper name and closed, then the temporary file is deleted
without the need for the user to confirm.

And that's it! Obviously the DisplayAlerts value can be moved down to make
this an entirely invisible process, and I will most likely add a msgbox to
announce that it has finished - but at least the bare bones are here!!

 

[Tom Ogilvy]

If all you wanted to do is make a copy of quotes as a separate workbook

Sub Makecopy
Dim TabName as String
TabName = Range("A1").value

worksheets("Quotes").copy
Activesheet.Name = TabName
Activeworkbook.SaveAs TabName
Activeworkbook.Close Savechanges:=False
End Sub

 

[Guest]

That would bring over all the associated VB code as well, which was not my aim

 

[Guest]

I have several situations where I have to do this (i.e. kill sectins of code
after they've run)..

My approach has always been:

Module1
Sub do_something()
Dim mySht As Worksheet

Application.DisplayAlerts = False
TabName = "Keep_This_one"

For Each mySht In ActiveWorkbook.Worksheets
If mySht.Name <> TabName Then mySht.Delete
Next mySht
Application.DisplayAlerts = True

Kill_Stupid_Code

End Sub

Module2
Sub Kill_Stupid_Code()
Dim vbComp As Object

On Error Resume Next

Set vbComp = Application.VBE.ActiveVBProject.VBComponents
vbComp.Remove vbcomponent:=vbComp.Item("Module1")

ThisWorkbook.SaveAs "New_File_Name.xls"
Application.DisplayAlerts = True
End Sub

This keeps the "original" file in tact so I can re-use it yet gives end
users access to a "no-code" file except for the save file code which is
pretty harmless should they accidentally run it

BAC

 

[Tom Ogilvy]

No, it is a simplified version of what you presented and said worked. If
there is no code in the sheet module, then there will be no code in the new
workbook. If there is code in the sheet module, then your method is no
different from mine.

 

[Tom Ogilvy]

But it doesn't provide the result requested by the OP:

The end result/output file can then be
passed on without the end user panicking over whether or not to access macros
etc etc.

The user still gets the enable macro prompt.

 

[Guest]

Sorry..

I interpreted OP to mean users worrying about accidentally running renamer
routine and killing off any new wksheets they may have created in their copy,
not "having macros", per se...

oops