excel workbook: do not allow certain file name

[omairhe]

Hello all,


Don't think this has ever been asked before, but how do I restrict file save [Before_Save Event] if the name of the file being saved is abc123.xlsx

A msgbox to notify user to change the filename, if this is the case.

Is it possible?
Thank you and will appreciate.

 

[omairhe]

For question 1, just change the initial filename to this "%USERPROFILE%\Desktop\Monthly Sales Report - month year".

As for your second question, I am getting confused and I am not sure I understand what is supposed to happen. Can you explain what the scenario is ?

The user saves the file and be prompted to save it via save dialog. The name is already inserted in it for him such as

"Monthly Sales Report - "

Now he saves it without changing the above and excel will not permit it. So far your code has achieved this.

Now a MsgBox telling him to add month and year at the end of the name. He is prompted again with the same name "Monthly Sales Report - " and hit on the Right arrow key and enters "May 2020" ,
giving the complete name "Monthly Sales Report - May 2020"
He saves with the above name and this should have been permitted. but with your latest code it is not allowing this as well. because of compare function perhaps. which means the user will have to remove the hyphen sign - from right and then add month and year like this
"Monthly Sales Report May 2020" in order for it to work. the hyphen is important to stay though.

Hope it is clear. but I will be more than happy to clarify anything.

 

[Jaafar Tribak]

See if this works :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    Dim userResponce As String
    Dim ExternalLinks As Variant
    Dim x As Long
    Dim wb As Workbook
    Set wb = ActiveWorkbook

Repeat:
 
    userResponce = Application.GetSaveAsFilename(InitialFileName:="%USERPROFILE%\Desktop\Monthly Sales Report - month year", _
    fileFilter:="Excel Workbook(*.xlsx), *.xlsx")
    If userResponce = "False" Then
        Exit Sub
    End If
    
    userResponce = Right(userResponce, Len(userResponce) - InStrRev(userResponce, "\", -1, vbTextCompare))
    
    If Not IsDate(Split(Split(userResponce, "-")(1), ".")(0)) Then
        MsgBox "Wrong file name"
        GoTo Repeat
    End If
    
    wb.Unprotect "1234"
    wb.ActiveSheet.Unprotect "1234"
    ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)

    If IsArray(ExternalLinks) Then
    For x = 1 To UBound(ExternalLinks)
    wb.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
    Next x

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    wb.SaveAs userResponce, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    End If
End Sub

 

[omairhe]

See if this works :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    Dim userResponce As String
    Dim ExternalLinks As Variant
    Dim x As Long
    Dim wb As Workbook
    Set wb = ActiveWorkbook

Repeat:

    userResponce = Application.GetSaveAsFilename(InitialFileName:="%USERPROFILE%\Desktop\Monthly Sales Report - month year", _
    fileFilter:="Excel Workbook(*.xlsx), *.xlsx")
    If userResponce = "False" Then
        Exit Sub
    End If
   
    userResponce = Right(userResponce, Len(userResponce) - InStrRev(userResponce, "\", -1, vbTextCompare))
   
    If Not IsDate(Split(Split(userResponce, "-")(1), ".")(0)) Then
        MsgBox "Wrong file name"
        GoTo Repeat
    End If
   
    wb.Unprotect "1234"
    wb.ActiveSheet.Unprotect "1234"
    ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)

    If IsArray(ExternalLinks) Then
    For x = 1 To UBound(ExternalLinks)
    wb.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
    Next x

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    wb.SaveAs userResponce, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    End If
End Sub

Seems to work but If the hyphen sign - is removed there seems to be an error that "subscript is out of range". Is there a way to do a repeat if the user tries to remove the hyphen sign?
Thank you for your help thus far.

 

[Jaafar Tribak]

How about this :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    Dim userResponce As String
    Dim ExternalLinks As Variant
    Dim x As Long
    Dim wb As Workbook
    Set wb = ActiveWorkbook

Repeat:
 
    userResponce = Application.GetSaveAsFilename(InitialFileName:="%USERPROFILE%\Desktop\Monthly Sales Report - month year", _
    fileFilter:="Excel Workbook(*.xlsx), *.xlsx")
    If userResponce = "False" Then
        Exit Sub
    End If
    
    userResponce = Right(userResponce, Len(userResponce) - InStrRev(userResponce, "\", -1, vbTextCompare))
    
    On Error Resume Next
        If Not IsDate(Split(Split(userResponce, "-")(1), ".")(0)) Then
            If Err.Number or Len(Split(userResponce, "-")(1)) Then
                MsgBox "Wrong file name"
                GoTo Repeat
            End If
        End If
    On Error GoTo 0
    
    
    wb.Unprotect "1234"
    wb.ActiveSheet.Unprotect "1234"
    ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)

    If IsArray(ExternalLinks) Then
    For x = 1 To UBound(ExternalLinks)
    wb.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
    Next x

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    wb.SaveAs userResponce, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    End If
End Sub

 

[omairhe]

How about this :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    Dim userResponce As String
    Dim ExternalLinks As Variant
    Dim x As Long
    Dim wb As Workbook
    Set wb = ActiveWorkbook

Repeat:

    userResponce = Application.GetSaveAsFilename(InitialFileName:="%USERPROFILE%\Desktop\Monthly Sales Report - month year", _
    fileFilter:="Excel Workbook(*.xlsx), *.xlsx")
    If userResponce = "False" Then
        Exit Sub
    End If
   
    userResponce = Right(userResponce, Len(userResponce) - InStrRev(userResponce, "\", -1, vbTextCompare))
   
    On Error Resume Next
        If Not IsDate(Split(Split(userResponce, "-")(1), ".")(0)) Then
            If Err.Number or Len(Split(userResponce, "-")(1)) Then
                MsgBox "Wrong file name"
                GoTo Repeat
            End If
        End If
    On Error GoTo 0
   
   
    wb.Unprotect "1234"
    wb.ActiveSheet.Unprotect "1234"
    ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)

    If IsArray(ExternalLinks) Then
    For x = 1 To UBound(ExternalLinks)
    wb.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
    Next x

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    wb.SaveAs userResponce, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    End If
End Sub

It will take some time for me to learn exactly how it works but you did it .
Many thanks and appreciate your time my dear.

 

[omairhe]

Just wondering why the more simpler "=" and "<>" did not work from the precious code?

 

[Jaafar Tribak]

Just wondering why the more simpler "=" and "<>" did not work from the precious code?

The code needs to extract the month and year from the userResponce string that's why it uses string manipulation functions such as Instr, Split, Right, Len and so on.
finally the code needs to make sure that the resulting sub-string corresponds to a valid date.