VBA - Excel - 重置 var 宏

Question

我希望你做得很好。 我寫了一個宏來保存帶有日期和時間的活動工作簿。 一切正常，除了小時，我重新運行代碼后日期沒有重置。

這是代碼：

Sub SaveFile()

Dim fname As String
Dim fdate As String
Dim fhour As String
Dim name As String
Dim name2 As String
Dim path As String
Dim f_name As String
Dim f_date As String
Dim f_hour As String
Dim n_ame As String
Dim n_ame2 As String
Dim p_ath As String

On Error GoTo First
fdate = Format(Date, "yyyy") & " " & Format(Date, "mm") & " " & Format(Date, "dd")
fhour = Format(Time, "hh") & "h" & Format(Time, "mm")
name = Left(ThisWorkbook.name, (InStrRev(ThisWorkbook.name, "_", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
fname = name & "_" & fdate & " - " & fhour
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & fname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

Exit Sub

First:

On Error GoTo -1
On Error GoTo Second
fdate = Format(Date, "yyyy") & " " & Format(Date, "mm") & " " & Format(Date, "dd")
fhour = Format(Time, "hh") & "h" & Format(Time, "mm")
name = Left(ThisWorkbook.name, (InStrRev(ThisWorkbook.name, "_", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
fname = name & "_" & fdate & " - " & fhour
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & fname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

Exit Sub

Second:
f_date = Format(Date, "yyyy") & " " & Format(Date, "mm") & " " & Format(Date, "dd")
f_hour = Format(Time, "hh") & "h" & Format(Time, "mm")
n_ame = Left(ThisWorkbook.name, (InStrRev(ThisWorkbook.name, ".", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
f_name = n_ame & "_" & f_date & " - " & f_hour
Application.ActiveWorkbook.SaveAs Filename:=path & "\" & f_name, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

宏當前第一次以所需格式保存，下一次將理解並留下正確數量的字符以保存為正確的所需格式。 我還設置了“第二次機會”，以防過早進入按下。

目前，如果我的工作簿名稱為“Workook”，宏會將其保存為“Workbook_2019 10 14 - 19h12”，而不是當前時間和日期值。

感謝您的幫助納克索斯

Answer 1

最后根據您的建議，我使代碼更簡單，現在一切正常。 我將它發布給下一個用戶

Private Sub SaveFile()
Dim fname As String
Dim fdate As String
Dim fhour As String
Dim name As String
Dim name2 As String
Dim path As String
Dim f_name As String
Dim ppfdate As String
Dim ppfhour As String
Dim ppfname As String
Dim ppfname2 As String
Dim pppath As String

dateactuelle = Now()

On Error GoTo First
fdate = Format(dateactuelle, "yyyymmdd - h\hmm")
name = Left(ActiveWorkbook.name, (InStrRev(ActiveWorkbook.name, "_", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
fname = name & "_v" & fdate

Application.ActiveWorkbook.SaveAs filename:=path & "\" & fname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Exit Sub

First:
ppfdate = Format(dateactuelle, "yyyymmdd - h\hmm")
ppfname = Left(ActiveWorkbook.name, (InStrRev(ActiveWorkbook.name, ".", -1, vbTextCompare) - 1))
path = Application.ActiveWorkbook.path
f_name = ppfname & "_v" & ppfdate

Application.ActiveWorkbook.SaveAs filename:=path & "\" & f_name, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub