excel workbook: do not allow certain file name

omairhe

Well-known Member
Joined
Mar 26, 2009
Messages
1,808
Office Version
2019
Platform
Windows
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.
 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,768
Office Version
2016
Platform
Windows
See if this works :
VBA Code:
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

Well-known Member
Joined
Mar 26, 2009
Messages
1,808
Office Version
2019
Platform
Windows
See if this works :
VBA Code:
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

Well-known Member
Joined
Dec 5, 2002
Messages
7,768
Office Version
2016
Platform
Windows
How about this :
VBA Code:
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

Well-known Member
Joined
Mar 26, 2009
Messages
1,808
Office Version
2019
Platform
Windows
How about this :
VBA Code:
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

Well-known Member
Joined
Mar 26, 2009
Messages
1,808
Office Version
2019
Platform
Windows
Just wondering why the more simpler "=" and "<>" did not work from the precious code?
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,768
Office Version
2016
Platform
Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,095,727
Messages
5,446,165
Members
405,388
Latest member
Arlind

This Week's Hot Topics

Top