SaveCopyAs without macros

[selkov]

How can I SaveCopyAs of a workbook and NOT save the macros from the workbook.

Failing that can I strip the macros after saving the workbook?

 

[BrianB]

Here is some code :-

'=======================================================
'- SAVE A WORKBOOK WITHOUT MACROS & USERFORMS
'- Brian Baulsom revised May 2007
'=======================================================
Sub SaveWithoutMacros()
    Dim WB As Workbook
    Dim MyVBcomponents As Object
    Dim MyVBcomponent As Object
    Dim MyCounter1 As Integer
    Dim MyCounter2 As Integer
    Dim MyCounter3 As Integer
    '-------------------------------
    On Error GoTo GetOut
    Application.Calculation = xlCalculationManual
    Set WB = ActiveWorkbook
    MyCounter1 = 0
    MyCounter2 = 0
    MyCounter3 = 0
    '----------------------------------------------------------------------
    rsp = MsgBox(UCase(WB.Name) & vbCr _
        & "About to delete all macros & save file.", vbOKCancel + vbExclamation)
    If rsp = vbCancel Then Exit Sub
    '---------------------------------------------------------------------
    '- loop components
    Set MyVBcomponents = WB.VBProject.vbComponents
    For Each MyVBcomponent In MyVBcomponents
        Application.StatusBar = MyVBcomponent.Name & "  Type :" & MyVBcomponent.Type
        Select Case MyVBcomponent.Type
            
            Case 1, 2       '- Standard & Class modules
                MyVBcomponents.Remove MyVBcomponent
                MyCounter1 = MyCounter1 + 1
            Case 3          '- Userforms
                MyVBcomponents.Remove MyVBcomponent
                MyCounter3 = MyCounter3 + 1
            Case Else       '- ThisWorbook & Sheet modules (can only remove code)
                With MyVBcomponent.CodeModule
                    If .CountOfLines > 0 Then
                        .DeleteLines 1, .CountOfLines
                        MyCounter2 = MyCounter2 + 1
                    End If
                End With
        End Select
    Next
    '----------------------------------------------------------------------
    '- finish
    Application.StatusBar = "Saving file"
    WB.Save
    MsgBox ("Removed components :-" & vbCr _
        & "Modules ....." & vbTab & ": " & MyCounter1 & vbCr _
        & "UserForms...." & vbTab & ": " & MyCounter3 & vbCr _
        & "Sheet code .." & vbTab & ": " & MyCounter2)
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    Exit Sub
GetOut:
    rsp = MsgBox("ERROR : " & vbCr & Err.Description, vbExclamation)
End Sub

 

[erik.van.geit]

Hi,

And here is some code by Daniel Klann
I do not have the link anymore, hence post the entire code
Will link to here in the future...

Sub SaveWithoutMacros()

'Purpose : To save a copy of the active workbook without macros

Dim vFilename As Variant
Dim wbActiveBook As Workbook
Dim oVBComp As Object
Dim oVBComps As Object


On Error GoTo CodeError


'Get a filename to save as
vFilename = Application.GetSaveAsFilename(filefilter:="Microsoft Excel Workbooks,*.xls", _
Title:="Save Copy Without Macros")

If vFilename = False Then Exit Sub 'User chose Cancel

ActiveWorkbook.SaveCopyAs vFilename
Set wbActiveBook = Workbooks.Open(vFilename)


'Now strip all VBA, modules, userforms from the copy

Set oVBComps = wbActiveBook.VBProject.VBComponents

For Each oVBComp In oVBComps
Select Case oVBComp.Type
Case 1, 2, 3 'Standard Module, Class Module, Userform
oVBComps.Remove oVBComp
Case Else
With oVBComp.CodeModule 'Worksheet or workbook code module
.DeleteLines 1, .CountOfLines
End With
End Select
Next oVBComp

wbActiveBook.Save

MsgBox "A copy of your workbook has been created with all VBA code removed.", vbInformation, "Success!"

Exit Sub

CodeError:
MsgBox Err.Description, vbExclamation, "An Error Occurred"

End Sub

 

[selkov]

thanks