Función de VBA para corregir un nombre reemplazando caracteres no deseados con guiones bajos

Vba

Módulo estándar

' module name: mod_CorrectName_s4p
'*************** Code Start ***************************************************
' Purpose  : replace unwanted characters in string with underscore (_)
' Author   : crystal (strive4peace)
' Code List: www.msaccessgurus.com/code.htm
' This code: 
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark your changes. Use at your own risk.
'--------------------------------------------------------------------------------
'                              CorrectName_s4p
'--------------------------------------------------------------------------------'
Function CorrectName_s4p( _ 
   ByVal psName As String _ 
   ) As String 
'strive4peace 221223, 230129
' replace spaces and unwanted characters with underscore _
' if 2 in a row, only use 1
' trim beginning and end

   Dim i As Integer _ 
      ,sName As String _ 
      ,sChar As String * 1 _ 
      ,sLastChar As String * 1 _ 
      ,sNewChar As String * 1 _ 
      ,iPos As Integer 
 
   'PARAMETERS
   'psName is the string you want to correct
 
   'EXAMPLE USEAGE
   '  on the AfterUpdate event of a control
   '  =CorrectName((controlname))
   '
   'in a query:
   'field --> CorrectName: CorrectName_s4p((strFieldname))
 
   'EXAMPLE
   ' ? CorrectName_s4p("as(,48209j@##@!")
   ' --> as_48209j_
 
   CorrectName_s4p =  ""
   If psName =  "" Then Exit Function 
   
   Dim sBadCharacters As String 
   sBadCharacters =  "`!@#$%^&*()+-=|\:;""',.?/ "
 
   psName = Trim(psName) 
 
   For i = 1 To Len(psName) 
      sChar = Mid(psName,i,1) 
 
      If InStr(sBadCharacters,sChar) > 0 Then 
         sNewChar =  "_"
      Else 
         sNewChar = sChar 
      End If 
 
      If sLastChar =  "_" And sNewChar =  "_" Then 
         'leave the same for multiple characters to replace in a row
      Else 
         sName = sName & sNewChar 
      End If 
 
      sLastChar = sNewChar 
   Next i 
 
   CorrectName_s4p = sName 
 
End Function 
'*************** Code End *****************************************************

‘ El código se generó con colores utilizando el complemento gratuito Color Code para Access.