如何用VBA实现将Excel 关闭后直接另存到一个指定的路径,并在另存文件名后自动获取系统时间
2011-11-02 16:41阅读：
本例假设文件另存为: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
INPUT>
追问
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:\可以自行修改,改为自己已经建立了的备份文件路径.
追问
非常感谢,解决了!!!!!!
