Question

我有一段高手给的EXCEL 自动保存的代码，如何让它保存时去掉VBA

代码如下，自动保存的副本打开又会再保存一个副本，所以想让保存的副本不要再带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

Answer 1

这个问题很深刻，我以为可以实现，但高手有高手的苦衷啊~

excel是这样的，自动保存后有个副本，副本在通过自身的VBA运行保存为下一个副本，也就是说下一个副本是通过上一个副本的VBA建立的，而不是通过初始的那个文件，所以高手使用的是ThisWorkbook.SaveCopyAs这个函数，这个函数将指定工作簿的副本保存到文件，但不修改内存中的打开工作簿，就是说每次都是将初始工作簿另存文件后，ThisWorkbook仍然为初始工作簿，而不是另存后的工作薄。但这个函数有个缺陷就是只能选择保存的文件名，而不能选择保存的文件类型，我试了下，将文件名直接写为"D:\20140109.xls"这种形式是没有问题的，所以将代码稍微改了下，保存后的xls是可以打开，但在代码运行过程中不要打开，在运行过程中打开，则ThisWorkbook变为打开的工作薄，代码运行就会出现你说的问题：

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 = ".xls" '工作簿文件扩展名（比如：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
    If Err Then Err.Clear                   '如过文件打开了则会发生错误，无视错误，继续。
    
    Application.DisplayAlerts = b           '恢复Application.DisplayAlerts之前的状态。
    Application.OnTime Time + TimeValue("00:00:05"), "OnTimeSave", , True   '设置下一个间隔时间自动保存
End Sub

追问

高手：
还是不行。
关闭初始文件后， 我打开另存的副本，副本仍然会再建1个副本

追答

恩，是的，在程序运行的过程中，副本不能打开的，副本一打开就会运行副本中的宏，你是想怎么样实现啊？

Answer 2

参考： http://club.excelhome.net/thread-1032212-1-1.html