Excel|如何使用VBA在工作簿文件名称后添加保存时间的后缀？|时间

 

Q：如何使用VBA在工作簿文件名称后添加文件保存时间的后缀，并且能不断的随着保存操作更新这个后缀？
A：在Thisworkbook里面加入下面的代码即可实现，并且能更新后缀，使得我们一眼就能看出文件的最后保存时间。
方法一 By 轩辕轼轲

1. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
2.       On Error Resume Next
   
3.       Application.DisplayAlerts = False
   
4.       Fold = ThisWorkbook.FullName
   
5.       Fpath = ThisWorkbook.Path
   
6.       ThisWorkbook.Save
   
7.       Application.DisplayAlerts = False
   
8.       T = Format(Now, " YYYY年MM月DD日HH时MM分SS秒")
   
9.       If Mid(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4, 1) = "秒" Then
   
10.          Temp = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 25)
    
11.          Else
    
12.          Temp = Split(ThisWorkbook.Name, ".")(0)
    
13.       End If
    
14.       Fname = Fpath & "\" & Temp & T & ".xls"
    
15.       ThisWorkbook.ChangeFileAccess xlReadOnly
    
16.       Name Fold As Fname
    
17.       Application.Workbooks.Open Fname, False
    
18.       ThisWorkbook.Close False
    
19.       Application.DisplayAlerts = False
    
20.       Cancel = False
    
21. End Sub

复制代码

方法二 By  KevinChengCW

1. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   
2. Dim mPath$, FN$, nName$
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False
   
5. Application.EnableEvents = False
   
6. FN = ThisWorkbook.Name
   
7. mPath = ThisWorkbook.Path
   
8. With ThisWorkbook
   
9.     .ChangeFileAccess xlReadOnly
   
10.     If InStr(FN, "-Ver") > 0 Then
    
11.         .SaveAs mPath & "\" & Split(FN, "-Ver")(0) & "-Ver" & Format(Now, "yyyymmddhhmmss") & "." & Right(FN, Len(FN) - InStrRev(FN, ".")), ThisWorkbook.FileFormat
    
12.     Else
    
13.         .SaveAs mPath & "\" & Left(FN, InStrRev(FN, ".") - 1) & "-Ver" & Format(Now, "yyyymmddhhmmss") & "." & Right(FN, Len(FN) - InStrRev(FN, ".")), ThisWorkbook.FileFormat
    
14.     End If
    
15. End With
    
16. Kill mPath & "\" & FN
    
17. Cancel = True
    
18. Application.EnableEvents = True
    
19. Application.DisplayAlerts = True
    
20. Application.ScreenUpdating = True
    
21. End Sub

复制代码