http://stackoverflow.com/a/14157011/1540567
This VBA function removes special characters from a string. In my case I wanted a single function to return a valid path and/or filename and/or VBAProject name. It works with both URL and UNC paths (and tries to clean up any paths with mixed slashes).
It's easy enough to tweak this for other purposes. You can specify additional "forbidden" characters easily and add any extra boolean switches for your own specific needs, or you could just split into separate functions.
The function also checks the maximum string length and either crops or pops up a message box if a filename (not path) exceeds 128 characters -- very useful for SharePoint uploads -- or a VBA object name exceeds 35 characters.
Function fn_Clean_Special(str As String, CropLength As Boolean _
, Optional VBObjectName As Boolean) As String
'v1.03 2013-01-04 15:54
'removes invalid special characters from path/file string
', True stops message box warnings and autocrops string
' [, True] also removes spaces and hyphens and periods (VBA object)
'~ " # % & * : < > ? { | } .. / \ -
Dim b As Integer, c As Integer, pp As String
Const tt As String = "fn_Clean_Special"
Dim sc(0 To 18) As String
sc(0) = "~"
sc(1) = Chr(34) ' Chr(34) = " quotemark
sc(2) = "#"
sc(3) = "%"
sc(4) = "&"
sc(5) = "*"
sc(6) = ":"
sc(7) = "<"
sc(8) = ">"
sc(9) = "?"
sc(10) = "{"
sc(11) = "|"
sc(12) = "}"
sc(13) = ".."
'slashes for filenames and VB Object names
sc(14) = "/"
sc(15) = "\"
'hyphen & space & period for VB Object names
sc(16) = "-"
sc(17) = " "
sc(18) = "."
'remove special characters from all
For b = 0 To 13
str = Replace(str, sc(b), vbNullString)
Next b
'check filename length (length AFTER the LAST slash max 128 chars)
b = InStr(1, str, sc(14)) 'look for fwd slash
If b > 0 Then
str = Replace(str, sc(15), sc(14)) 'remove all back slashes
Do Until b = 0 'until last slash found
c = b 'c is position of last slash
b = b + 1 'next position
b = InStr(b, str, sc(14)) 'next position
Loop
Else 'no fwd slashes
b = InStr(1, str, sc(15)) 'look for back slash
If b > 0 Then
str = Replace(str, sc(14), sc(15)) 'remove all fwd slashes
Do Until b = 0 'until last slash found
c = b 'c is position of last slash
b = b + 1 'next position
b = InStr(b, str, sc(15)) 'next position
Loop
End If
End If
'c is position of last slash, or 0 if no slashes
If Len(str) - c > 128 Then
If CropLength = True Then
str = Left(str, 35)
Else
pp = "WARNING: filename > 128 chars"
MsgBox pp, vbCritical, tt
End If
End If
'remove slashes from filenames only
If c > 0 Then
For b = 14 To 15
str = Left(str, c) & Replace(Right(str, Len(str) - c), sc(b), vbNullString)
Next b
End If
If VBObjectName = True Then
'remove slashes and swap hyphens & spaces & periods for underscore in VB object name
Const scUS As String = "_"
For b = 14 To 18
str = Replace(str, sc(b), scUS)
Next b
'then remove invalid characters from start of string
Dim c1 As String
c1 = Left(str, 1)
Do While c1 = scUS Or c1 = sc(18) Or IsNumeric(c1)
str = Right(str, Len(str) - 1)
c1 = Left(str, 1)
Loop
'remove double underscore
Do While InStr(str, scUS & scUS) > 0
str = Replace(str, scUS & scUS, scUS)
Loop
'check object name length (max 35 chars)
If Len(str) > 35 Then
If CropLength = True Then
str = Left(str, 35)
Else
pp = "WARNING: object name > 35 chars"
MsgBox pp, vbCritical, tt
End If
End If
End If
fn_Clean_Special = str
End Function
Debug Window results:
?fn_clean_special("\\server\path\filename.xls", True)
\\server\path\filename.xls
?fn_clean_special("\\server\path\filename.xls", True, True)
server_path_filename_xls
?fn_Clean_Special("\\special character\testing for \VBproject.xls", True, True)
special_character_testing_for_VBpro
