Como posso substituir caracteres proibidos em um nome de arquivo antes de salvar no VBA?

Question

Isso será muito simples para alguém que conhece o VBA melhor que eu. Eu usei um código original fornecido pelo usuário Nixda neste fórum para divide planilha excel em vários arquivos CSV com base no valor da coluna (muito obrigado Nixda!).

Meu único problema é que alguns desses valores de coluna contêm caracteres especiais (~ "#% & *: < >? {|} /) e, portanto, criam um erro ao salvar porque o nome do arquivo CSV é ditado por o valor da coluna e estes são caracteres proibidos para nomes de arquivos.

Existe algum código adicional que eu possa adicionar para substituir os caracteres proibidos por um sublinhado no nome do arquivo, mas não no valor da coluna?

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

Para simplificar, basta adicionar as seguintes linhas ao seu código antes de "strFilename = strOutputFolder &" \ "& strItem":

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

[ATUALIZADO] Bem, como o @Dave mencionou (e ele está certo) melhora assim:

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

... e depois ligue assim:

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