Reputation: 2300
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.
Upvotes: 3
Views: 11356
Reputation: 2300
I found this here:
http://enholm.net/index.php/blog/vba-code-to-transfer-excel-2007-xlsx-books-to-2003-xls-format/
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
Debug
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
Loop
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
Next
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
ActiveWindow.Close
End Sub
Upvotes: -1