Visual Basic - Eliminar caracteres especiales en nombre de archivo de archivos adjuntos de outlook

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil
Val: 1
Ha aumentado su posición en 26 puestos en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

Eliminar caracteres especiales en nombre de archivo de archivos adjuntos de outlook

Publicado por Gustavo (1 intervención) el 11/05/2020 02:02:33
Buenas tardes estimados:

Una consulta por favor:

Quiero agregar una funcionalidad más a mi código, la que consiste en eliminar los caracteres especiales de los nombres de archivos de los archivos adjuntos del correo de outlook. Ya que cuando me llega unos archivos con esos caracteres no los puedo descargar.

Me salta un error en la linea
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName

al parecer cuando trata de guardar el archivo en la pc.

Esta primera parte del codigo es para descargar los adjuntos de tipo zip, xml, pdf

1
2
3
4
5
6
7
8
9
10
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Users\gustav\Documents\Attachments\"
     For Each objAtt In itm.Attachments
    If ((InStr(objAtt.DisplayName, ".xml") Or InStr(objAtt.DisplayName, ".zip") or InStr(objAtt.DisplayName, ".PDF") Or InStr(objAtt.DisplayName, ".pdf"))) Then
              objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          End If
     Next
End Sub



Por otro lado, encontré por la web un código para eliminar los caracteres especiales pero no logro unificar el código, el problema no soy muy bueno con lenguajes de programación y a la hora de tratar de integrarlos me saltan diferentes errores. Les adjunto un txt hasta donde logré avanzar

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function limpiarCadenaNombreFichero(cadenaTexto As String, _
    sustituirPor As String) As String
  Dim tamanoCadena, i, cadenaResultado, caracteresValidos As String
  Dim caracterActual As String
 
  tamanoCadena = Len(cadenaTexto)
  If tamanoCadena > 0 Then
    caracteresValidos = _
        " 0123456789abcdefghijklmnñopqrstuvwxyzABCDEFGHIJKLMNÑOPQRSTUVWXYZ-_."
    For i = 1 To tamanoCadena
      caracterActual = Mid(cadenaTexto, i, 1)
      If InStr(caracteresValidos, caracterActual) Then
        cadenaResultado = cadenaResultado & caracterActual
      Else
        cadenaResultado = cadenaResultado & sustituirPor
      End If
    Next
  End If
 
  limpiarCadenaNombreFichero = cadenaResultado
End Function


Captura
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder