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
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

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
- Codigo-unido-pero-no-funciona.zip(675,0 B)
Valora esta pregunta


0