Как заменить запрещенные символы в именах файлов перед сохранением в VBA?

Question

Это будет очень просто для тех, кто знает VBA лучше меня. Я использовал исходный код, предоставленный пользователем Nixda на этом форуме, чтобы разделить рабочую таблицу Excel на несколько файлов CSV на основе значения столбца (большое спасибо, Nixda!).

Моя единственная проблема заключается в том, что некоторые из этих значений столбцов содержат специальные символы (~ "#% & *: <>? {| } /) и, следовательно, создает ошибку при сохранении, поскольку имя файла CSV определяется значением столбца, а это запрещенные символы для имен файлов.

Есть ли дополнительный код, который я могу добавить, чтобы заменить запрещенные символы подчеркиванием в имени файла, но не в значении столбца?

Sub GenerateCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

iCol = 4                                '### Define your criteria column
strOutputFolder = "CSV output"          '### Define your path of output folder

Set ws = ThisWorkbook.ActiveSheet       '### Don't edit below this line
Set rngLast = Columns(iCol).Find("*", Cells(1, iCol), , , xlByColumns, xlPrevious)
ws.Columns(iCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUnique = Range(Cells(2, iCol), rngLast).SpecialCells(xlCellTypeVisible)

If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder
For Each strItem In rngUnique
  If strItem <> "" Then
    ws.UsedRange.AutoFilter Field:=iCol, Criteria1:=strItem.Value
    Workbooks.Add
    ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=[A1]
    strFilename = strOutputFolder & "\" & strItem
    ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlCSV
    ActiveWorkbook.Close savechanges:=False
  End If
Next
ws.ShowAllData

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 1

Для простоты просто добавьте следующие строки в ваш код перед "strFilename = strOutputFolder &"\"& strItem":

strItem= replace(strItem, "~", "_")
strItem= replace(strItem, """, "_")
strItem= replace(strItem, "%", "_")
strItem= replace(strItem, "#", "_")
' and so long ...
strFilename = strOutputFolder & "\" & strItem

[ОБНОВЛЕНО] Ну, как упоминал @Dave (и он прав), сделайте так лучше:

Function ReplaceSpecialChars(strIn As String, strChar As String) As String
    Dim strSpecialChars As String
    Dim i As Long
    strSpecialChars = "~"#%&*:<>?{|}/"

    For i = 1 To Len(strSpecialChars)
        strIn = Replace(strIn , strSpecialChars(i), strChar)
    Next

    ReplaceSpecialChars = strIn 
End Function

... а затем назовите это так:

strFilename = strOutputFolder & "\" & ReplaceSpecialChars(strItem, "_")