Remove all restricted characters from save file name

[mweick]

Hello,

On my spreadsheet we have a submit that users click after they enter all their information and that initiates an excel macro I wrote to save the file to a certain location. Here is the code I am currently using:

Sub SaveFile()
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Range("ED1").Value ' New directory name

strFilename = Range("B11").Value 'New file name
strDefpath = "S:\" 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub

MkDir strDefpath & strDirname
strPathname = strDefpath & strDirname & "\" & strFilename 'create total string

ActiveWorkbook.SaveAs Filename:=strPathname, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

As you can see, the file name is saved off of whatever is entered in cell B11. The problem is, sometimes users have to enter characters such as \ / : * ? " < > |into cell B11 and then when they hit the submit button it gives them a confirmation that the file saved successfully even though it didn't because there were one of the characters mentioned above in cell B11.

I tried to figure this out but I can't. I need some code to be written in this macro to still allow the entering of those characters in cell B11 but when they click submit, I need the macro to strip all of the characters above just for the save file name while keeping the characters physically in cell B11.

Any help would be greatly appreciated!

 

[mole999]

please note this is four years old thread, visitors here assist as and when they choose, you should read the forum rules and apply them when posting

 

[doublecritch]

Just for the sake of my own curiosity, I ran a speed test on two of the methods above, and also tried to script my own.
Each function was asked to clean the string: "Hellow: /Wor:ld, ?Hello Worl//d" 10000 times
Results:

ValidFileNameCompare -​	0.1640 s
ValidFileNameArray -​	0.2187 s
ValidFileNameRegEx -​	14.5039 s

Sub TestRegEx()
    
    Dim temp As String
    Dim I As Long
    Dim ST
    
    ST = Timer
    For I = 1 To 10000
        temp = ValidFileNameRegEx(Application.Trim("Hellow: /Wor:ld, ?Hello Worl//d"))
    Next I
    Debug.Print "ValidFileNameRegEx = " & Timer - ST
    
    ST = Timer
    For I = 1 To 10000
        temp = ValidFileNameArray(Application.Trim("Hellow: /Wor:ld, ?Hello Worl//d"))
    Next I
    Debug.Print "ValidFileNameArray = " & Timer - ST
    
    ST = Timer
    For I = 1 To 10000
        temp = ValidFileNameCompare(Application.Trim("Hellow: /Wor:ld, ?Hello Worl//d"))
    Next I
    Debug.Print "ValidFileNameCompare = " & Timer - ST
    
End Sub
Private Function ValidFileNameRegEx(Arg As String) As String
    Dim RegEx As Object
    Set RegEx = CreateObject("VBScript.RegExp")
    With RegEx
        .Pattern = "[\\/:\*\?""<>\|]"
        .Global = True
        ValidFileNameRegEx = .Replace(Arg, "")
    End With
End Function
Private Function ValidFileNameArray(Arg As String) As String
    Dim Arr
    Dim I As Byte
    Arr = Array("\", "\", "/", ":", "\", "*", "\", "?", """", """", "<", ">", "\", "|")
    ValidFileNameArray = Arg
    For I = LBound(Arr) To UBound(Arr)
        ValidFileNameArray = Replace(ValidFileNameArray, Arr(I), "")
    Next I
End Function
Function ValidFileNameCompare(ByVal FileName As String) As String
  Dim X As Long
  For X = 1 To Len(FileName)
    If Mid(FileName, X, 1) = "]" Or Mid(FileName, X, 1) Like _
       "[! 0-9A-Za-z^&'@{}[,$=!#()%.+~_-]" Then Mid(FileName, X, 1) = "*"
  Next
  ValidFileNameCompare = Replace(FileName, "*", "")
End Function