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

我认为您已经有了答案。目录功能适用于文件夹和文件。

因此，您可以按照检查文件夹是否存在的相同方式检查文件是否存在。

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

    'save file..
Else

    msgbox("File already exists")

End if

应该可以解决问题

避免覆盖刚刚创建的文件

1 个答案: