Избегайте перезаписи только что созданного файла

Question

Код создает папки и сохраняет файл Excel в соответствии с сегодняшней датой, как только вы откроете шаблон. После того, как вы измените шаблон, вы можете просто нажать кнопку «Сохранить» и распечатать его.

Проблема возникает при повторном открытии шаблона в тот же день, он перезапишет существующий файл. Есть ли способ проверить, существует ли файл (согласно сегодняшней дате)? Если так, покажите сообщение о том, что он уже существует, а если нет, следуйте коду как есть?

Option Explicit
Public WithEvents MonitorApp As Application

Private Sub Workbook_Open()
Dim strGenericFilePath      As String: strGenericFilePath = "\\Server2016\Common\Register\"
Dim strYear                 As String: strYear = Year(Date) & "\"
Dim strMonth                As String: strMonth = MonthName(Month(Date)) & "\"
Dim strDay                  As String: strDay = Day(Date) & "\"
Dim strFileName             As String: strFileName = "Register Sheet " & Format(Date, "mmm dd yyyy")
Application.DisplayAlerts = False
' Check for year folder and create if needed
If Len(Dir(strGenericFilePath & strYear, vbDirectory)) = 0 Then
MkDir strGenericFilePath & strYear
End If
' Check for month folder and create if needed
If Len(Dir(strGenericFilePath & strYear & strMonth, vbDirectory)) = 0 Then
MkDir strGenericFilePath & strYear & strMonth
End If
' Check for date folder and create if needed
If Len(Dir(strGenericFilePath & strYear & strMonth & strDay, vbDirectory)) = 0 Then
MkDir strGenericFilePath & strYear & strMonth & strDay
End If
' Save File
ActiveWorkbook.SaveAs Filename:= _
strGenericFilePath & strYear & strMonth & strDay & strFileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True
' Popup Message
MsgBox "File Saved As: " & vbNewLine & strGenericFilePath & strYear & strMonth & strDay & strFileName
End Sub

Answer 1

Я думаю, у тебя уже есть ответ. Функция Dir работает как с папками, так и с файлами.

Таким образом, вы можете проверить, существует ли файл так же, как вы проверяете, существуют ли папки.

If len(dir(strGenericFilePath & strYear & strMonth & strDay & strFileName & ".xlsm")) = 0 then

    'save file..
Else

    msgbox("File already exists")

End if

должен сделать трюк