Descarga automática masiva de archivos adjuntos en Outlook (en Windows)

[@3djdavid]

Código para descargar todos los archivos adjuntos en una sola carpeta, cuidado que sobreescribirá los archivos que tengan el mismo nombre. Public Sub All_in_One(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String Dim strFileName As String Dim strNewName As String Dim fso Dim intExtlen As Integer Dim strPre As String Dim strExt As String Dim dateFormat dateFormat = Format(Now, "yyyy-mm-dd") Set fso = CreateObject("Scripting.FileSystemObject") '------------------------------------------------------------------------------ saveFolder = "C:\Users\Chanchito\Desktop\outlook\" ' -cualquier archivo aqui '------------------------------------------------------------------------------ 'Revisa los adjuntos For Each objAtt In itm.Attachments strFileName = objAtt.DisplayName intExtlen = Len(strFileName) - InStrRev(strFileName, ".") + 1 'Revisa la extension del archivo If InStrRev(strFileName, ".") > 0 Then strExt = Right(strFileName, intExtlen) strPre = Left(strFileName, Len(strFileName) - intExtlen) Else strExt = "" strPre = strFileName End If strNewName = strPre & strExt ' Asignar el nuevo nombre strFileName = strNewName 'Guardar archivo objAtt.SaveAsFile saveFolder & "\" & strFileName Set objAtt = Nothing Next itm.UnRead = False End Sub Private Sub ReplaceIllegalChars(asunto As String, sChr As String) asunto = Replace(asunto, "/", sChr) asunto = Replace(asunto, "\", sChr) asunto = Replace(asunto, ":", sChr) asunto = Replace(asunto, "?", sChr) asunto = Replace(asunto, Chr(34), sChr) asunto = Replace(asunto, "", sChr) asunto = Replace(asunto, "|", sChr) asunto = Replace(asunto, "*", sChr) End Sub

[@MariannyGarciaSanchez]

y si no quiero que se reemplacen los archivos con el mismo nombre?

[@alexcorvi]

Excelente, David !!!. El script me ha dado la solución a un tema que tenía pendiente. Muchas gracias por tu aportación. Por si a alguién le sirve, he incluido borrar los adjuntos del email una vez grabados en el directorio: incluir estas lineas después de la salida del For Each inicial, debajo de itm.UnRead = False ... For Each objAtt In itm.Attachments ... Next itm.UnRead = False For i = 1 To itm.Attachments.Count itm.Attachments.Remove 1 Next i End Sub

[@gcpa68]

Excelente aporte!! Muy fácil de seguir, funcionó perfecto. Gracias.

[@3djdavid]

super, gracias por avisar, ya ha pasado un tiempo desde que lo subí.

[@juanruiz8758]

Gracias David, me funcionó perfecto y muy muy bien explicado 👌. Like

[@3djdavid]

ah!, me alegro mucho!, gracias!

[@stamcoldcrazy123]

Que gran aporte super detallado, gracias David y saludos !!

[@3djdavid]

gracias a ti, saludos!

[@DacarSoft]

Excelente explicación amigo, en un trabajo anterior hice algo similar a esto, donde descargaba archivos planos, y luego con otro programa hecho en C# insertaba cierta información en una base de datos, fue un tema de facturación electrónica. Digamos que ya teniendo el archivo, puedes usar otros lenguajes de programación como python, C# o Java, para programar alguna acción con ese archivo.

[@heidiwinkler857]

Gracias por el gran aporte 👏👏👏

[@3djdavid]

Gracias por comentar!

[@RigoVerastica]

Fue de mucha ayuda. Muchas gracias Sergio.

[@3djdavid]

Con mucho gusto

[@andresyanez7487]

La raja compadreeee clarito clarito, funciono IMPEQUE

[@glaserose7698]

Me salvaste la vida, pude descargar un montón de archivos que se perdieron de mi nube. En mi mail de empresa, recomendasismo!

[@3djdavid]

me alegro mucho, saludos!

[@andymena491]

Muchas gracias, bien explicado :D

[@FaridMonti]

Muy buena manera de hacer este proceso, gracias, ya la estoy usando

[@3djdavid]

Excelente, me alegro mucho!

[@jo.ojanGPT]

Tremendo TIP, años descargando facturas, me funcionó perfect. Muchas Gracias

[@3djdavid]

me alegro, muchas gracias!

[@gustavoromero4317]

Estimado David: Mil Gracias. Primeramente te comento que no soy programador, pero me gusta siempre aprender algo nuevo. El desarrollo de la explicacion (Paso a Paso, incluyendo la de ir a activar el Script )me sirvio para entregar una tarea de descargar desde 1980 correos con adjuntos "txt". Ahora mi inquietud es : Que le deberia de cambiar a tu script si quiero ser mas personalizado y solo quiero que desde un sender en especifico o desde un Asunto en Especifico descargar/guardar esos Adjuntos ? Desde Ya Muchas Gracias por ese FeedBack. Sigue Adelante!

[@3djdavid]

genial!, me disculpo ya que he tenido mucho trabajo por entregar. Apenas termine sigo mejorando los archivos, favor atentos a siguientes videos!, gracias.

[@kiader]

¿Como lo hago para descargar así los pdf de correos antiguos y no de los que apenas me van a enviar?

[@ccaceressony]

Sos grande tigre! que excelente solución

[@3djdavid]

Muchas gracias!

[@chasconmtl]

Mil gracias.

[@lauralozano7760]

Hola david, pregunta se podria hacer con los archivos comprimidos? Donde me sirve solo decargar el Pdf, pero esta dentro del ZIP con el XML

[@matiasdibella6492]

funciona perfecto!!!!!!

[@garyoportu8100]

David, el programa no adjunta todos los adjuntos del correo, lo que hace es guardar los adjuntos que van llegando al correo. ¿tienes alguna foma de descargar los adjuntos históricos del correo?

[@kriziafernandaarteagadiaz2017]

Cómo le puedo hacer si quiero que todos los archivos se descarguen en la misma carpeta

[@joaquingutierrez1062]

Hola David, gracias por compartir este consejo, es muy práctico, tendrás algún otro para descargar archivos adjuntos pero que se tienen sobre una lista creada desde Excel?

[@joelsc5312]

Muchas gracias por tu aportación, de mucha utilidad, que pasa si ya tengo 300 correos que recibí con información previamente PDFS. puedo seleccionarlos y correr alguna forma este script para que los descargue? gracias.

[@3djdavid]

Siento la demora en responder. Se puede mover los mails a la carpeta recibidos e ir a reglas y clic a administrar reglas, luego seleccionas la regla y das clic a ejecutar.

[@eduardovasquezpacheco8691]

Buenos dias Sergio Espero te encuentres muy bien. Por algun motivo no me esta funcionando con Windows 11

[@3djdavid]

Soy David, no Sergio

[@eduardovasquezpacheco8691]

@@3djdavid Perdon David si es que al querer realizar tu ejercicio no me esta funcionando no se si sera por ser windows 11

[@davidwebchile]

@@eduardovasquezpacheco8691 voy a revisar, recien tengo windows 11

[@davidwebchile]

probado en windows 11, funciona bien.

[@joankarloangulobardales6324]

buenas tardes, me sale un mensaje que dice: No se pueden guardar los datos adjuntos. La ruta de acceso no existe. compruebe que la ruta de acceso sea correcta. como opciones depurar y finalizar. Ayuda por favor

[@3djdavid]

Es windows no?, lo pudo solucionar, siento responder ahora. Estaban los mensajes en revisión.

[@karinayanez2905]

me aparece el mismo error, que hacemos en estos casos?

[@3djdavid]

@@karinayanez2905 hola, siento la tardanza en responder, ya pudo solucionarlo?, si aún requiere ayuda favor me escribe a mi email, gracias.

[@dassonjosea6295]

Gracias por el video. He realizado todos los pasos; pero al crear la nueva regla en la parte donde hay que escojer el script no me pone ningún nombre, o sea que "alguien-, es decir algo" está bloqueando que aparezcan los script para poder escogerlo. Favor ayuda.

[@NelsonQuiterio]

Saludos. Si yo quiero que el archivo que venga con el mismo nombre se me sobre escriba que debo cambiar en el código?

[@3djdavid]

Borrar estas lineas: 'Revisa que consecutivo asignar al nombre (1), (2), (3), etc. While fso.fileexists(saveFolder2 & "\" & strNewName) = True w = w + 1 strNewName = strPre & Chr(40) & w & Chr(41) & strExt Wend

[@yuranymolina154]

Hola Sergio, muchas gracias por tu video me ayudado, pero tengo una duda: estoy descargando archivos ZIP y necesito que tomen el nombre del asunto pero no me deja, sabes si se debe cambiar algo adicional?

[@jotasimunovic]

Hola David!! una pregunta, existe la posibilidad de descargar un archivo que viene como "URL" dentro del email? es decir lo que hago yo siempre, manualmente hago clic en el link URL, se abre un PDF y luego descargo.. hay forma de hacerlo automatico?

[@Sky6109]

Felicidades David por tus aportes de envío de correos y este. Dime, has hecho alguna actualización reciente sobre envío masivo de correos? Saludos

[@3djdavid]

No, google ha desactivado la opcion de app menos seguras y ahora es necesario habilitar la verificacion en dos pasos de google. Una vez allí aparecerá un nuevo item para generar un password para ingresar en vez de tu pass normal de gmail.

[@Sky6109]

@@3djdavid Hola de nuevo. No comprendo tu respuesta. Creo que me estas explicando la forma de seguridad en dos pasos de google pero te pregunté si has hecho alguna actualización a tu sistema de envío masivo de correos. Saludos

[@3djdavid]

@@Sky6109 disculpa la demora, no he realizado ningún cambio. Aún tienes ese problema?

[@hernandorativa2141]

Buenas tardes, mil gracias por la info, cómo podría que me cree una carpeta cada vez que descarga archivos nuevos de cada correo, que no todo quede en una sola carpeta si no que quede una carpeta individual los adjuntos de cada mail??

[@enriquemedrano3208]

muy buenas noches, gracias por su aporte, pero tan solo funciona para la pc local. gracias.

[@3djdavid]

Así es, lo explico en la descripción, sorry.

[@ANGEL0297]

Cuando quiero agregar el scripts aparece vacío

[@UlisesMaldonado]

Excelente,lo probaré, con este script sería para descargar adjuntos futuros, o sea apartir de que se implemente ó se descargarian tambien todos los adjuntos ya recibidos?

[@serviciosadministrativos1452]

Hola! Muchas gracias por el aporte... quisiera consultarte si hay alguna manera de cambiar automáticamente el nombre del archivo que se descarga, por el Asunto del correo... Gracias una vez mas

[@nidyaherrera7634]

Quiero igual q obtenga el nombre del adjunto del asunto

[@guillermomoralesgarcia9264]

hola y si quiero que se descarguen automaticamente los archivos mp4 (videos) que se le tiene que cambiar ayuda porfavor

[@javiypatri]

este Script funciona con PDF recibidos al Outlook , es decir si tengo 20 pdfs en mi bandeja se podrian descargar todos

[@3djdavid]

si

[@Analista-s1h]

Hola, si quiero que se guarden archivos dw word y pdf en la misma carpeta?

[@3djdavid]

en el primer coment que fijé dejé listo eso hace rato.

[@patitus25]

Una consulta, no me aparece cuando cre la regla selecciono este equipo , no aparece lo del script.

[@3djdavid]

eso lo comento en el tiempo 12:30

[@moisesvega6206]

Si quiero que cambie el nombre al qué tiene como asunto a los pdf

[@erivanr9710]

Tengo 2 dudas: 1.- Se puede hacer que al descargar creer una carpeta con el nombre del subject del correo? Osea, carpeta por correo. 2.- Se puede hacer que descargue con limitaciones, ejemplo si de un adjunto quiero solamente los archivos su nombre empiecen con cierta letra o numero

[@FrancoArambulo]

Hola, genial el codigo, pero no me esta apareciendo la opcion ejecutar scrup en o365 con elreggedit modificado tendrias alguna reomendacion?

[@3djdavid]

Al parecer no se puede para esa version de office.

[@JoseDiaz-tx2so]

Genial! pero si tenemos sistema de 64bits?

[@3djdavid]

Yo tengo sistema de 64bits, pero está realizado para Office de 32bits, no la versión dfe office 64.

[@manuelpalaciossantil]

Si deseo descargar todos los atach

[@marcelobravo3074]

para que es esto? outlok ya permite descargar archivos adjuntos en masa desde la propia web

[@3djdavid]

Public Sub Adjuntos_PDF(itm As Outlook.MailItem) Dim objAtt As Outlook.Attachment Dim saveFolder As String Dim strFileName As String Dim strNewName As String Dim fso Dim intExtlen As Integer Dim strPre As String Dim strExt As String Dim getFrom getFrom = itm.SenderName Dim asunto As String Dim MENSAJE As String asunto = itm.Subject MENSAJE = itm.Body Dim dateFormat dateFormat = Format(Now, "yyyy-mm-dd") Set fso = CreateObject("Scripting.FileSystemObject") '------------------------------------------------------------------------------ saveFolder1 = "C:\Users\Chanchito\Desktop\outlook\pdf\" ' -Preferencia aqui saveFolder2 = "C:\Users\Chanchito\Desktop\outlook\" ' -cualquier archivo aqui extensionArchivo = "pdf" '------------------------------------------------------------------------------ 'Revisa los adjuntos For Each objAtt In itm.Attachments ' si es txt no coloca nombre de quien lo envia ni fecha. If ((InStr(objAtt.DisplayName, "." & extensionArchivo))) Then strFileName = objAtt.DisplayName 'Revisa si existe el archivo en la carpeta destino If fso.fileexists(saveFolder1 & "\" & strFileName) = True Then strNewName = strFileName intExtlen = Len(strFileName) - InStrRev(strFileName, ".") + 1 'Revisa la extension del archivo If InStrRev(strFileName, ".") > 0 Then strExt = Right(strFileName, intExtlen) strPre = Left(strFileName, Len(strFileName) - intExtlen) Else strExt = "" strPre = strFileName End If 'Revisa que consecutivo asignar al nombre (1), (2), (3), etc. w = 1 While fso.fileexists(saveFolder1 & "\" & strNewName) = True w = w + 1 strNewName = strPre & " " & Chr(40) & w & Chr(41) & strExt Wend ' Asignar el nuevo nombre strFileName = strNewName w = 0 End If 'Guardar archivo con nuevo nombre objAtt.SaveAsFile saveFolder1 & "\" & strFileName AttachmentCount = AttachmentCount + 1 Set objAtt = Nothing Else: ' Aqui para cada correo entrante se editara archivo adjunto con nombre y fecha de recibido ReplaceIllegalChars asunto, "-" strFileName = getFrom & " " & dateFormat & "_" & asunto & "_" & objAtt.DisplayName 'Revisa si existe el archivo en la carpeta destino If fso.fileexists(saveFolder2 & "\" & strFileName) = True Then strNewName = strFileName intExtlen = Len(strFileName) - InStrRev(strFileName, ".") + 1 'Revisa la extension del archivo If InStrRev(strFileName, ".") > 0 Then strExt = Right(strFileName, intExtlen) strPre = Left(strFileName, Len(strFileName) - intExtlen) Else strExt = "" strPre = strFileName End If 'Revisa que consecutivo asignar al nombre (1), (2), (3), etc. While fso.fileexists(saveFolder2 & "\" & strNewName) = True w = w + 1 strNewName = strPre & Chr(40) & w & Chr(41) & strExt Wend ' Asignar el nuevo nombre strFileName = strNewName w = 0 End If 'Guardar archivo con nuevo nombre objAtt.SaveAsFile saveFolder2 & "\" & strFileName AttachmentCount = AttachmentCount + 1 Set objAtt = Nothing End If Next itm.UnRead = False End Sub Private Sub ReplaceIllegalChars(asunto As String, sChr As String) asunto = Replace(asunto, "/", sChr) asunto = Replace(asunto, "\", sChr) asunto = Replace(asunto, ":", sChr) asunto = Replace(asunto, "?", sChr) asunto = Replace(asunto, Chr(34), sChr) asunto = Replace(asunto, "", sChr) asunto = Replace(asunto, "|", sChr) asunto = Replace(asunto, "*", sChr) End Sub

[@carloscastanon6393]

Beautiful> I love it man. Pero me salio un problema . Me podrias ayudar . Me dice que hay un problema en este commando objAtt.SaveAsFile saveFolder2 & "\" & strFileName

[@Hansel2994]

saludos David, se perdió mi canal de YT de 3D

[@3djdavid]

Hola Jaime, por el momento lo dejé un poco de lado, pero hice algunas cosillas con mi impresora de resina 3D. Luego lo retomaré. Saludos!

[@eduardovasquezpacheco8691]

Buenos dias David El sistema me esta dando el siguiente error Esta regla solo se ejecuta cuando compruebe su correo electrónico. Si no se esta ejecutando Outlook, esta regla no funcionará para comprobarlo en línea o desde otro dispositivo de correo electrónico".

[@davidwebchile]

y tienes acceso normal para enviar o recibir correos en outlook?