代码如下，自动保存的副本打开又会再保存一个副本，所以想让保存的副本不要再带VBA了。或者能保存为其他格式如HTML类的也好，我自己修改半天搞不定。
Option Explicit
Sub Auto_Open()
Application.OnTime Time + TimeValue('00:00:05'), 'OnTimeSave', , True '设置自动保存开始
End Sub
Sub Auto_Close()
On Error Resume Next
Application.OnTime Time, 'AutoSave', , False
End Sub
Sub OnTimeSave()
'Private Const interval As Long = 5 / 60 '自动保存的间隔时间，以分钟为单位
Dim today As String
Dim path As String, fileName As String, fileExt As String '将这三个变量定义为模块级变量，不需要每次执行autosave过程时，都要取一次值。
Dim saveAs As String '保存为新的文件名
Dim b As Boolean
today = Application.WorksheetFunction.Text(Date, 'YYYYMMDD') '日期格式为：4位年2位月份2位日期，
'修改'YYYYMMDD'，可以得到不同的日期格式，但是要注意 / 在windows系统是不允许作为文件名的
path = ThisWorkbook.path & '\' '默认是工作簿所在的路径，可以指定一个文件夹作为备份的文件夹
fileExt = '.htm' '工作簿文件扩展名（比如：test.xls，此变量的值将是 .xls）
fileName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - Len(fileExt)) '工作簿文件名，不含扩展名 （比如：test.xls，此变量的值将是 test）
saveAs = path & fileName & '-' & today & fileExt '新的文件名
Debug.Print Time, saveAs & Excel.XlFileFormat.xlHtml
b = Application.DisplayAlerts '保存原来的Application.DisplayAlerts状态，以便恢复用。
Application.DisplayAlerts = False '不提示覆盖保存
On Error Resume Next
ThisWorkbook.SaveCopyAs saveAs & Excel.XlFileFormat.xlHtml
If Err Then Err.Clear '如过文件打开了则会发生错误，无视错误，继续。
Application.DisplayAlerts = b '恢复Application.DisplayAlerts之前的状态。
Application.OnTime Time + TimeValue('00:00:05'), 'OnTimeSave', , True '设置下一个间隔时间自动保存
End Sub
本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请
点击举报。
