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

Макрос, который в настоящий момент сохраняется в первый раз в требуемом формате и в следующий раз, поймет и оставит правильное количество символов для сохранения вправильный формат. Я также установил «второй шанс» в случае слишком раннего нажатия клавиши Enter.

В настоящее время, если моя книга называется «Workook», макрос сохранит ее как «Workbook_2019 10 14 - 19h12», а не текущие значения времени и даты.

Спасибо за вашу помощь Naxos

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