Excel – Delete all Macros/vba when save as xls workbook


I am using a procedure that creates a file and copies my workbook (xlsm) and saves as a xls workbook to the created file, and this is working well.

I need to remove all Macros and vba when the save as is exacuted, i.e I need to remove the Macros/vba from the workbook being saved NOT the original workbook.

I know I could save it as a xlsx workbook to remove all Macros and vba but I need the workbook to be a Macro/vba free xls workbook.

I have Google'ed but did not find anything I could use, will continue to look and post back if I get this figured out.

Best Solution

I found this here:


It searches through a dirictory looking for xlsx files and changes them to xls files

I think though it can be changed to look for xlsm files and change them to xls files as well.

When I run it I get:

Run-Time error '9' Subscript out of range

Sheets("List").Cells(r, 1) = Coll_Docs(i)
is highlighted in yellow

I do not know enough about vba to figure out what is not working. Thanks

Sub SearchAndChange()
Dim Coll_Docs As New Collection

Dim Search_path, Search_Filter, Search_Fullname As String

Dim DocName As String

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Dim i As Long

Search_path = ThisWorkbook.Path & "\360 Compiled Repository\May_2013"

Search_Filter = "*.xlsx"

Set Coll_Docs = Nothing
DocName = dir(Search_path & "\" & Search_Filter)

 Do Until DocName = ""

    Coll_Docs.Add Item:=DocName

    DocName = dir


 r = 1

 For i = Coll_Docs.Count To 1 Step -1

     Search_Fullname = Search_path & "\" & Coll_Docs(i)

     Sheets("List").Cells(r, 1) = Coll_Docs(i)

      Call changeFormats(Search_path, Coll_Docs(i))

      r = r + 1


Application.DisplayAlerts = True

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

End Sub

'* Changes format from excel 2007 to 2003

Sub changeFormats(ByVal dir As String, ByVal fileName As String)

 Workbooks.Open fileName:=dir & fileName

 ActiveWorkbook.SaveAs fileName:=dir & Replace(fileName, "xlsx", "xls"),   FileFormat:=xlExcel8

End Sub