파일명에 특수기호만 제거하는 방법이 궁금해요

Sub 파일분할저장()
 
Dim rng As Range, drng As Range
Dim d As Object, c As Variant, lr As Long, i As Long
Dim keys() As String
Dim strPath As String, strName As String
 
Dim intChoice As Integer '하나의 파일만 열도록 지정
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show
 
If intChoice <> 0 Then
strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Else: Exit Sub
End If
 
Workbooks.Open strPath
With ActiveWorkbook
strName = Left(.Name, InStrRev(.Name, ".") - 1)
strPath = .Path & Application.PathSeparator
End With
 
With ActiveSheet
On Error Resume Next
 
Set rng = Application.InputBox(Prompt:="기준열을 선택하시오", Type:=8)
Set drng = Application.InputBox(Prompt:="데이터의 시작행을 선택하시오", Type:=8)
Set d = CreateObject("Scripting.Dictionary")
    lr = .Cells(Rows.Count, rng.Column).End(xlUp).Row
    c = .Range(.Cells(drng.Row, rng.Column), .Cells(lr, rng.Column)) '시작 행 번호
 
   For i = 1 To UBound(c, 1)
   d(c(i, 1)) = 1
   Next i
   ReDim keys(UBound(d.keys)) As String
   c = d.keys
   For i = LBound(c) To UBound(c)
   keys(i) = CStr(c(i))
   Next i
 
   If ActiveSheet.AutoFilterMode Then ActiveSheet.ShowAllData
      .Range("A1").CurrentRegion.Select
      For i = LBound(keys) To UBound(keys)
      Selection.AutoFilter Field:=rng.Column, Criteria1:="=" & keys(i)
      .Range("A1").CurrentRegion.Select
      Selection.SpecialCells(xlCellTypeVisible).Select
      Selection.Copy
      Workbooks.Add
      ActiveSheet.Paste
      Application.CutCopyMode = False
 
      Columns("A:M").Select
      Columns("A:M").EntireColumn.AutoFit
      Range("A1").Select
 
      ActiveWorkbook.SaveAs fileName:=strPath & strName & "_" & keys(i) & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      ActiveWorkbook.Close SaveChanges:=False
      Next i
  If ActiveSheet.AutoFilterMode Then ActiveSheet.ShowAllData
 
  End With
 
  ActiveWorkbook.Close SaveChanges:=False
 
  End Sub