Hi Hans
Copy this macro in your personal.xls
http://www.rondebruin.nl/personal.htm
It will create a copy of the activeworkbook and save it with a date time stamp in the same folder
I have many hundreds of workbooks a month
If you want to do all workbooks in one go and all the files are in one folder then
we can create a copy of the folder with code and loop through them.
But test this example first
Sub Save_Workbook_No_Code()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Set wb1 = ActiveWorkbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
TempFilePath = wb1.Path & "\"
TempFileName = wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
With wb2
If .VBProject.Protection = 0 Then
DeleteAllVBA wb2
Else
MsgBox "Sorry can't delete the VBA code because the project is protected.", _
, "Error"
End If
.Close SaveChanges:=True
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Public Sub DeleteAllVBA(mybook As Workbook)
Dim VBComp As Object
Dim VBComps As Object
Set VBComps = mybook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 1, 3, _
2
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp
End Sub
