Question

如何用VBA实现将Excel 关闭后直接另存到一个指定的路径,并在另存文件名后自动获取系统时间

Answer 1

不知道是不是这个意思：在Excel的ThisWorkbook模块中，粘贴下列代码。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    ThisWorkbook.Save'保存本文件
    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs "D:\ff\测试" & Format(Now, "yyyy年m月d日 h时m分s秒") & ".xls"'另存为其它文件，这里弄成你自己的路径和文件名
    Application.DisplayAlerts = True
End Sub

Answer 2

本例假设文件另存为:C:\aaa.xls,你可以自行修改
请在ThisWorkBook对象中输入如下代码:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWorkbook.SaveAs Filename:="C:\aaa.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

追问

我另存为的文件名不想覆盖之前的文件名,所以想在文件名后面自动获得系统时间,这个怎么做呢?

追答

已新改,试试.
本例假设文件另存为:C:\aaa.xls,time()取得系统时间,文件路径和文件名你可以自行修改
请在ThisWorkBook对象中输入如下代码:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim MyFileName as String
MyFileName="C:\aaa.xls"&time()
ActiveWorkbook.SaveAs Filename:=MyFileName, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

追问

Sub 宏1()
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim MyFileName as String
MyFileName="C:\aaa.xls"&time()
ActiveWorkbook.SaveAs Filename:=MyFileName, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ThisWorkbook.Save
End Sub

运行时弹出缺少end sub ,我再添加一个end sub 也还是这样,什么原因呢?

追答

说明:
首先.这个代码要在ThisWorkBook对象中输入.具体操作如下:
1.按ALT+F11,打开工程资源管理器(CTRL+R),这时窗口左侧出现资源管理器,
2.双击资源管理器中的ThisWorkBook,这时在右侧出现代码编写窗口.
3.在编写窗口中左边下拉框,选择WorkBook,再在右边下拉框选择BeforeClose
4.此时光标停在:如下两行代码之间
Private Sub Workbook_BeforeClose(Cancel As Boolean)
请把第5点的代码复制到此处-----这行是空行,文字是为了说明下面而加的
End Sub
5.把如下代码复制到上述两行代码之间.
Dim MyFileName as String
MyFileName="C:\aaa"&time()&".xls"
ActiveWorkbook.SaveAs Filename:=MyFileName, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ThisWorkbook.Save

追问

HI,高人
另存文件名后面自动获取系统时间这个运行还是不成功也!!!!

追答

问题找到了可能是时间格式不对:重新开始
说明:
首先.这个代码要在ThisWorkBook对象中输入.具体操作如下:
1.按ALT+F11,打开工程资源管理器(CTRL+R),这时窗口左侧出现资源管理器,
2.双击资源管理器中的ThisWorkBook,这时在右侧出现代码编写窗口.
3.在编写窗口中左边下拉框,选择WorkBook,再在右边下拉框选择BeforeClose
4.此时光标停在:如下两行代码之间
Private Sub Workbook_BeforeClose(Cancel As Boolean)
请把第5点的代码复制到此处-----这行是空行,文字是为了说明下面而加的
End Sub
5.把如下代码复制到上述两行代码之间.
==========================================
(=====上面这部分没有改变,下面的代码请复制)
Dim MyFileName As String
Dim MyPath As String
MyPath = "C:\"
If Not ThisWorkbook.Path & "\" = MyPath Then
MyFileName = MyPath & "aaa" & Hour(Time()) & "时" & Minute(Time()) & "分" & Second(Time()) & "秒" & ".xls"
ActiveWorkbook.SaveAs Filename:=MyFileName, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ThisWorkbook.Save
End If
6.保存文件.
7.当关闭文件后,会在C:\目录下出现一个文件,例如,aaa10时32分05秒.xls........,打开后关闭一次就会另存一次.
注意:
MyPath="C:\"这行的C:\可以自行修改,改为自己已经建立了的备份文件路径.

追问

非常感谢,解决了!!!!!!

Answer 3

excel自动另存需要编写宏函数。

1. 可以在ThisWorkBook对象中输入代码完成，

2. 代码如下：

   Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWorkbook.SaveAs Filename:="C:\aaa.xls", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False End Sub

3. 其中C:\aaa.xls就是所备份的文件的路径。