避免覆盖刚刚创建的文件

亨利·纳瓦罗

一旦您打开模板，该代码就会根据今天的日期创建文件夹并保存一个 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

溪

我想你自己已经有了答案。Dir 函数适用于文件夹和文件。

因此，您可以像检查文件夹是否存在一样检查文件是否存在。

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

    'save file..
Else

    msgbox("File already exists")

End if

应该做的伎俩

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。