Cómo desinfectar un nombre de archivo

Como parte 2 de mi publicación sobre Cómo validar un nombre de archivo para garantizar que se ajuste a la convención de nomenclatura de Microsoft Windows, consulte:

También quería demostrar cómo podríamos sanear alternativamente cualquier nombre de archivo propuesto. De modo que, en lugar de validar o informar problemas con el nombre de archivo propuesto, podríamos simplemente eliminar los problemas y devolver un nombre de archivo válido.

El principio es muy similar al código para realizar la validación, pero en su lugar reemplazamos los caracteres/términos infractores.

El código se convierte así:

'---------------------------------------------------------------------------------------
' Procedure : Filename_Sanitize
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Sanitize a filename, thus eliminating any non-conforming characters/terms
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - 
' Req'd Refs: None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFileName             : Filename to sanitize (including extension)
' sReplacementCharacter : Character to use to replace illegal characters/terms
'
' Usage:
' ~~~~~~
' ? Filename_Sanitize("VBA Samples and Explanations.docx")
'   Returns -> VBA Samples And Explanations.docx
'
' ? Filename_Sanitize("VBA Samples >>> Explanations.docx")
'   Returns -> VBA Samples ___ Explanations.docx
'
' ? Filename_Sanitize("VBA Samples >>> Explanations.docx", "")
'   Returns -> VBA Samples  Explanations.docx
'
' ? Filename_Sanitize("VBA Samples >>> Explanations.docx", "-")
'   Returns -> VBA Samples - --Explanations.docx
'
' ? Filename_Sanitize("COM3.docx")
'   Returns -> ____.docx
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2024-03-25              Public release
' 2         2024-03-28              Filename ending with '..' or '  '
'---------------------------------------------------------------------------------------
Public Function Filename_Sanitize(sFilename As String, _
                                  Optional sReplacementCharacter As String = "_") As String
    On Error GoTo Error_Handler
    Dim iCounter              As Long
    Dim aChars()              As String
    Dim aNames()              As String
    Dim sFilenameWOExt        As String    'Filename without extension
    Dim sFilenameExt          As String
    Const sIllegalChrs = ",:,"",/,\,|,?,*"
    Const sIllegalNames = "CON,PRN,AUX,NUL,COM0,COM1,COM2,COM3,COM4,COM5,COM6,COM7,COM8" & _
          ",COM9,COM¹,COM²,COM³,LPT0,LPT1,LPT2,LPT3,LPT4,LPT5,LPT6,LPT7" & _
          ",LPT8,LPT9,LPT¹,LPT²,LPT³"

    'illegal characters
    aChars = Split(sIllegalChrs, ",")
    For iCounter = 0 To UBound(aChars)
        sFilename = Replace(sFilename, aChars(iCounter), sReplacementCharacter)
    Next iCounter

    'Ascii 0 through 31
    For iCounter = 0 To 31
        sFilename = Replace(sFilename, Chr(iCounter), sReplacementCharacter)
    Next iCounter

    'Illegal names
    If InStr(sFilename, ".") > 0 Then
        sFilenameWOExt = Left(sFilename, InStrRev(sFilename, ".") - 1)
        sFilenameExt = Right(sFilename, Len(sFilename) - InStrRev(sFilename, "."))
    Else
        sFilenameWOExt = sFilename    'No Extension
    End If
    aNames = Split(sIllegalNames, ",")
    For iCounter = 0 To UBound(aNames)
        If sFilenameWOExt = aNames(iCounter) Then
            sFilename = String(Len(sFilenameWOExt), sReplacementCharacter) & _
                        "." & sFilenameExt
        End If
    Next iCounter

    'End with '..' or '  '
    If Right(sFilename, 2) = ".." Then
         sFilename = Left(sFilename, Len(sFilename) - 2) & sReplacementCharacter & "."
    End If
    If Right(sFilename, 2) = "  " Then
         sFilename = Left(sFilename, Len(sFilename) - 2) & sReplacementCharacter & "."
    End If

    Filename_Sanitize = sFilename

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: Filename_Sanitize" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl  0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Luego podemos usarlo simplemente haciendo:

    Dim sFilename             As String

    sFilename = "VBA Samples and Explanations.docx"
    sFilename = Filename_Sanitize(sFilename)
    Debug.Print sFilename

Lo cual daría como resultado

VBA Samples and Explanations.docx

O

    Dim sFilename             As String

    sFilename = "VBA Samples > Explanat|ions.docx"
    sFilename = Filename_Sanitize(sFilename, "")
    Debug.Print sFilename

que a su vez produce

VBA Samples  Explanations.docx

O

    Dim sFilename             As String

    sFilename = "COM3.docx"
    sFilename = Filename_Sanitize(sFilename, "-")
    Debug.Print sFilename

y el resultado es

----.docx

Tenga en cuenta también que si desea evitar que los usuarios utilicen otros caracteres más allá de los mencionados específicamente por Microsoft en su documentación, todo lo que tiene que hacer es agregarlos a la declaración sIllegalChrs en la función.