Inicio MS / Office

VBScript para guardar automáticamente archivos adjuntos Outlook



Ultima Actualización del Artículo: May 11, 2017

Hace poco uno de nuestros clientes comenzó a enviar facturas electrónicas para realizar tramites por medio de correo electrónico, el cual envia aproximadamente 30 facturas por hora en correos separados cada una, el cual para la persona encargada de realizar sus tramites su trabajo se torno un tanto tedioso y le quitaba tiempo en estar guardando en la carpeta manualmente cada factura, el cual optamos por automatizar esto.

En la empresa optamos por utilizar Attachment Save Add-In de Sperry Software [Ver articulo], pero si no deseamos comprar un programa o solo necesitamos algo con mayor configuración podemos utilizar un Script en Visual Basic el cual cumple perfectamente la función de guardar automáticamente los archivos adjuntos que se reciben por correo electrónico en Outlook.

Configurando el VBScript en Outlook

Nota: Outlook – Opción ejecutar un script (run a script) no aparece en las reglas

  • Es muy importante que tengamos la carpeta creada en el lugar que especificamos en el Script (Ejemplo en C:\XML o C:\Archivos [Que son los que se muestran en los ejemplos])create-folder
  • Ahora ya cada que nos llegue un correo que cumpla las condiciones especificadas en la configuración se ejecutara nuestro Script.

Códigos VBScript para guardar automáticamente archivos adjuntos en Outlook

VBScript que guarda todos los archivos recibidos (Remplaza existentes del mismo nombre).

Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Archivos\"
     For Each objAtt In itm.Attachments        
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName        
          Set objAtt = Nothing    
     Next
End Sub

VBScript que guarda todos los archivos recibidos (No remplaza existentes agrega la fecha al archivo).

Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "C:\Archivos"
     For Each objAtt In itm.Attachments        
          objAtt.SaveAsFile saveFolder & "\" & dateFormat & " - "& objAtt.DisplayName       
          Set objAtt = Nothing    
     Next
End Sub

VBScript que guarda archivos de cierto peso (tamaño), por ejemplo para evitar que guarde las imágenes de las firmas de los remitentes.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Archivos"
     For Each objAtt In itm.Attachments
        If objAtt.Size > 5000 Then 'Ajustar el tamaño al peso para excluir los archivos en Bytes
              objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          End If
     Next
End Sub

VBScript que guarda cierto tipo de archivo (Ejemplo: .xml y remplaza archivos del mismo nombre).

Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\XML\"
     For Each objAtt In itm.Attachments        
    if InStr(objAtt.DisplayName, ".xml") Then
              objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          end if
     Next
End Sub

VBScript que guarda varios tipos de archivos (Ejemplo: .xml y .pdf – remplaza archivos del mismo nombre).

Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\XML\"
     For Each objAtt In itm.Attachments        
    if ((InStr(objAtt.DisplayName, ".xml") Or InStr(objAtt.DisplayName, ".pdf"))) Then
              objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          end if
     Next
End Sub

VBScript que guarda cierto tipo de archivo (Ejemplo: .xml y No remplaza existentes agrega la fecha al archivo).

Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "C:\XML\"
For Each objAtt In itm.Attachments        
              if InStr(objAtt.DisplayName, ".xml") Then
              objAtt.SaveAsFile saveFolder & "\" & dateFormat & " - "& objAtt.DisplayName
          end if    
     Next
End Sub

VBScript que guarda todos los archivos recibidos (No remplaza existentes agrega la fecha al archivo y Nombre de la persona quien lo envió “From / De”).

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
Dim getFrom
    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
    getFrom = itm.senderName
saveFolder = "C:\Archivos\"
     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & "\" & dateFormat & " - " & getFrom & " - " & objAtt.DisplayName
          Set objAtt = Nothing
          Set itm = Nothing
     Next
End Sub

VBScript que guarda todos los archivos recibidos (No remplaza existentes agrega la fecha al archivo, Parte del Asunto (Subject))

En la linea 14 se utiliza Mid para extraer parte del subject este el primer numero indica a partir de que carácter comenzara a contar y el siguiente indica cuantos caracteres tomara.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
Dim getSubject As String
dateFormat = Format(Now, "yyyy-mm-dd H-mm")
saveFolder = "C:\Archivos\"
' get Subject
getSubject = itm.Subject
 
    For Each objAtt In itm.Attachments
      If InStr(UCase(objAtt.DisplayName), ".XML") Then
        ReplaceIllegalChars getSubject, "-"
        finalSubject = Mid(getSubject, 4, 12)
        objAtt.SaveAsFile saveFolder & dateFormat & " – " & finalSubject & " – " & objAtt.DisplayName
       End If
    Next
End Sub
 
Private Sub ReplaceIllegalChars(getSubject As String, sChr As String)
  getSubject = Replace(getSubject, "/", sChr)
  getSubject = Replace(getSubject, "\", sChr)
  getSubject = Replace(getSubject, ":", sChr)
  getSubject = Replace(getSubject, "?", sChr)
  getSubject = Replace(getSubject, Chr(34), sChr)
  getSubject = Replace(getSubject, "<", sChr)
  getSubject = Replace(getSubject, ">", sChr)
  getSubject = Replace(getSubject, "|", sChr)
  getSubject = Replace(getSubject, "*", sChr)
End Sub

VBScript guarda archivos adjuntos sin duplicar agregando un consecutivo (1), (2), etc. a los archivos repetidos.

Se debe especificar la ruta donde se guardaran los archivos en la linea 11

Public Sub saveAttachtoDisk(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
Set fso = CreateObject("Scripting.FileSystemObject")
saveFolder = "C:\1-Tests\"
	'Revisa los adjuntos
     For Each objAtt In itm.Attachments
        strFileName = objAtt.DisplayName
		'Revisa si existe el archivo en la carpeta destino
        If fso.fileexists(saveFolder & "\" & 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(saveFolder & "\" & 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 saveFolder & "\" & strFileName
          AttachmentCount = AttachmentCount + 1
          Set objAtt = Nothing
     Next
End Sub

 

VBScript Crea Carpeta con Nombre de Remitente y Guarda Adjuntos en la carpeta correspondiente.

En la linea 11 se especifica el folder raíz donde se guardaran las subcarpetas de cada remitente.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
Dim getFrom
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")

    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
    getFrom = itm.senderName
    saveFolder = "C:\Archivos\" & getFrom & "\"

If Not oFSO.FolderExists(saveFolder) Then
  oFSO.CreateFolder saveFolder
End If

     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & "\" & dateFormat & " - " & objAtt.DisplayName
          Set objAtt = Nothing
          Set itm = Nothing
     Next
End Sub
Artículos que te pueden interesar:
 
COMPARTIR
Mi nombre es Fernando, soy analista de sistemas actualmente trabajo en una empresa con mas de 200 empleados que utilizan equipo de computo al cual se les da soporte en el departamento. Uno de mis pasatiempos fuera de la empresa es escribir artículos para PortalMasTips donde documento los problemas, inquietudes y detalles interesantes que se presentan.

268 Comentarios

  1. Hola Buenos dias,

    mi inconveniente es mas desde la base.
    No encuentro en mi outlook la opcion “run a script”, como hago para habilitarla estoy usando Outlook 2010, Gracias de antemano

    • Estimado autor, me gustaría saber si puedo tener varios (scripts) para que se ejecuten y me distribuya los adjuntos dependiendo de la regla a varias carpetas específicas.

      • Buen dia Humberto,

        Si puedes tener varios Scripts, por ejemplo en la primer linea se especifica el nombre del script, puedes cambiarlo a tu gusto por ejemplo: Public Sub GrabarAdjuntosPDF (itm As Outlook.MailItem) o Public Sub GrabarAdjuntosDePortalMasTips (itm As Outlook.MailItem). y especificar en saveFolder = “C:AdjuntosPortalMasTips” la ruta donde guardara el adjunto, tendremos que crear una regla por cada uno de ellos el cual va a ser la parte fundamental ya que en esta vamos a definir cuando debe ejecutarse cada regla, se puede llegar a presentar un caso de mayor análisis si deseas guardar los adjuntos de una misma persona y un mismo tipo de archivo, para esto se tendria que encontrar algun patron el cual se logre diferenciar cada correo, ya sea una palabra en el subject, nombre de archivo, etc.

        Si se te presenta alguna otra duda no dudes en consultarnos.

      • Yo tengo el mismo problema JEN y Fernando, alguna sugerencia para solucionarlo, no me aparece la macro al configurar la regla, si ejecuto la macro en modo Desarrollo si ejecuta pero no me aparece en la lista de Scripts de las reglas.

        Public Sub holamundo()
        MsgBox (“Hola Mundo”)
        End Sub

        de antemano les agradezco su ayuda.

        gracias,

    • Buen aporte, mis felicitaciones; porque era mi caso me llegaban mensualmente 800 facturas electrónicas y guardar una por una es muy tedioso.
      Ahora como hago para leer esos archivos adjuntos, ya estan descargados ahora tengo que ingresar a un excel (fecha de emisión, tipo de documento, serie, número, etc.), los archivos adjuntos me lo envian en formato pdf y xml.

      Por favor su ayuda!!!
      Muchas gracias…

    • Buen dia.
      quisiera saber que le debo cambiar al script para que pueda guardar los correos electrónicos en una carpeta predeterminada por fuera del PST, tengan o no archivos adjuntos
      muchas gracias

      • Buen día

        Vamos a realizar un artículo explicando esto a mas a detalle, en la semana lo publicamos por si requiere más información. Dando solución a su consulta el Script cambiaria completamente, se siguen los mismos pasos para crear las reglas.

        Public Sub SaveMsg(Item As Outlook.MailItem)
          Dim sPath As String
          Dim dtDate As Date
          Dim sName As String
          Dim enviro As String
          
          enviro = CStr(Environ("USERPROFILE"))
          sName = Item.Subject
          ReplaceCharsForFileName sName, "_"
          dtDate = Item.ReceivedTime
          sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
            vbUseSystem) & Format(dtDate, "-hhnnss", _
            vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"
        ' Guardar en Documentos del Usuario actual, se puede cambiar folder especificando la ruta completa por ejemplo: sPath = “C:CorreosElectronicos”
            sPath = enviro & "Documents"
          Debug.Print sPath & sName
          Item.SaveAs sPath & sName, olMsg
        End Sub
          
        Private Sub ReplaceCharsForFileName(sName As String, _
          sChr As String _
        )
          sName = Replace(sName, "/", sChr)
          sName = Replace(sName, "", sChr)
          sName = Replace(sName, ":", sChr)
          sName = Replace(sName, "?", sChr)
          sName = Replace(sName, Chr(34), sChr)
          sName = Replace(sName, "<", sChr)
          sName = Replace(sName, ">", sChr)
          sName = Replace(sName, "|", sChr)
        End Sub

        Script realizado por vboffice

        Saludos.

        • gracias por su colaboración, ya cree la regla, pero al ejecutarla me genera el siguiente error:

          “se ha producido un error’-2147287037 (80030003)’ en tiempo de ejecución:

          error en la operación”

          al darle la opción de depurar me envía a la siguiente linea del código

          Item.SaveAs sPath & sName, olMSG

          que debo modificarle?

          muchas gracias

          • Buen dia,

            No debes modificar nada en el código, asi como se encuentra debe guardar por default en el folder de mis documentos, intenta especificando una ruta en el código le puse un comentario, en la línea que se encuentra exactamente debajo del comentario debes especificar la ruta, primero has una prueba creando una carpeta en el C:Correos (por ejemplo) y este lo especificas en el código.
            El comentario es el siguiente ‘ Guardar en Documentos del Usuario actual, se puede cambiar folder especificando la ruta completa por ejemplo: sPath = “C:CorreosElectronicos”

            Si funciona asi el error es al momento de buscar el USERPROFILE.

            Nos comentas cual fue el resultado.

        • Hola!!

          Primero que nada quiero agradecerles por el apoyo que brindan a las personas de este foro, por otra parte, les comento que este scrip me es de mucha ayuda y me ha salvado poruq evan a desactivar los pst proximamente en mi trabajo, pero tengo un detalle o necesidad y me gustaria que me pudieran ayudar.

          Yo tengo en mi pst de respalo muchas carpetas donde divido los correos por nombre de los clientes (los cuales son muchos correos), se podria hacer que este script copie las carpetas con su contenido al folder donde las estoy copiando, para que queden con la misma organización que tengo en el pst, y si no es mucha molestia, como puedo hacerle para que en el nombre del archivo .msg, que se copia del outlook al folder, tambien tenga el nombre de la persona que lo envia para que quede de esta manera.

          “Date-Time-From-Subjet.msg” (los formatos en que estan actualmente la fecha y hora son geniales para poderlos organizar.)

          Les agradecesria bastante que me pudieran ayudar.

          • Buen dia Hernanmty!

            La parte que me comentas de respaldar el PST en un directorio conservando la estructura de las carpetas se puede hacer pero se sale completamente del contexto del código de este articulo, para esto de requiere algo completamente diferente lo analice un poco y realice una búsqueda rápida en Internet para ver procedimientos ya hechos el cual si encontré uno en C# el cual podría servirnos para realizar lo que pides, en la semana le realizare unas modificaciones. el cual quizas el formato que quieres el nombre del correo no se consiga, pero vamos a ver parece otro caso interesante el cual resolver :).

            Aun que por otro lado si te urge y el dinero no es problema existen programas como MessageSave

            Saludos.

          • Hola, buen día.

            Perdon por responder algo tarde, andaba con mucho trabajo. Me salvaron la vida con el script!, es exactamente lo que necesitaba, les agradezco mucho la ayuda que me proporcionaron!!

            Saludos.

        • Hola, buen día.

          Nuevamente pidiendo de su amable apoyo con respecto a este script, les comento que me ha servido mucho por las razones que habia comentado anteriormente, pero ahora estoy teniendo problemas con ciertos correos, me han salido 2 casos en que no respalda o se salta dichos correos, un correo que se salta es en donde en el subjet tiene el caracter “→” (flechita hacia la derecha) y el otro es que el subject es demasiado largo, lo malo es que son comunes estos tipos de correos aqui en mi empresa.

          De antemano les agradesco el apoyo. Saludos!

          • Buen dia

            Se necesitan eliminar los caracteres no validos para los nombres de archivos y carpetas en Windows, en el codigo en la linea 80 encuentras lo siguiente RegX.Pattern = “[” & Chr(34) & “!@#$%^&*()=+|[]{}`’;:<>?/,]”

            A esta agrega separando con la diagonal los caracteres → etc, etc.

            Nos comentas como te va con el cambio.

            Saludos.

          • Hola que tal.

            Solo para aclarar, las dudas son en el script de arriba realizado por vboffice, pero con lo que me indicaron encontre la solución, solo añadi la sig. linea:

            sName = Replace(sName, Chr(26), sChr)

            Ya que no podia colocar la flechita tal cual en el editor de VB asi que la puse en codigo y con esto me funciono.

            Para el segundo caso en que el subject es demasiado largo que exede el largo maximo permitido en nombres de archivos en windows, estos correos tampoco los respalda, ¿como pudiera solucionar esto? ¿existe alguna forma de recortar el nombre? y que siga quedando la estructura del mismo.

            Saludos.

    • Buenos días.
      Quisiera me recomendara un Script para que al creat un mensaje de correo nuevo le inserte un numero como referencia. Y que cada mensaje tenga el numero siguiente al anterior. Y asi sucesivamente

      Seria posible ?

      Saludos / Javier

    • Estimados,
      En primer lugar muchas gracias por su colaboración, me ha servido muchísimo. Así mismo, agradecería poder indicarme si es posible agregar a la función de guardado el recorrido al “.xls” adjunto y validar la estructura como nombre de la cabecera de las columnas, tipo de datos de cierta columna, nombre de la sheet, etc. Espero poder contar con su pronto apoyo.
      Saludos,
      Rony Monant

      • Buen dia Rony

        Necesitamos comprender cual es el objetivo y conocer que resultado espera para poder apoyarle, Entendemos lo que requiere es fuera de Outlook?, seria en el documento Excel para revisar su estructura y que seria el resultado que espera obtener?

    • Hola.
      Sólo quiero agradecer el tiempo y trabajo dedicado para colgar estos códigos y ayudas.

      Me parece súper útil para mí, y después de corregir algunos fallos (míos claro) me ha funcionado perfectamente.

      MUCHAS GRACIAS.

    • Buen día, excelente aporte el que nos haces. Tengo una cuestión en particular, tenemos una aplicación en un multifuncional que escanea los documentos y los envía a un repositorio y simultáneamente a un correo, el detalle es que que los adjuntos los envía por separado. Necesito descargar los archivos que llegan de ese correo (ya lo hice con el script) y ver si cuando se descarguen a esa carpeta se reenvíen a otro correo o los adjunte a un correo para solo introducir el correo al que deseamos se envíe. Gracias

      • Buen dia Daniel!

        Ya revisaste la opción “forward it to people or public group” en el paso que es lo que va a realizar cuando llegue un correo que cumpla las condiciones? (Donde seleccionamos Run a Script en los pasos mencionados), al seleccionar esta te va a reenviar el correo que recibiste a las personas o correos que tu especificas en la regla y a la vez ejecutara el script para que se continúen guardando los archivos donde ya configuraste.

        Saludos, nos haces saber si es lo que estas buscando.

    • Buen dia, ejecute el script y lo aplique a mi necesidad, funciona bien pero cada cierto tiempo da un error sin codigo(no muestra codigo de error) y deja de procesar el script como puedo hacer para que se salte cuando haya error y continue ejecutando el script y no desactive la regla.

      ya que cuando hay error desactiva la regla y no guarda los adjuntos.

      muchas gracias de nuevo por su ayuda

      • Buen dia Jonathan
        No me ha tocado ver un error similar con un Script, se podra identificar si el error es del Script o es de Outlook? me refiero a si has llegado a notar en que momento marca el error, tambien me pudes proporcionar tu código para ver si no es por alguna de los cambios que se hicieron.

    • Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
      Dim objAtt As Outlook.Attachment
      Dim saveFolder As String
      Dim dateFormat
      Dim getFrom
          dateFormat = Format(Now, "DD-MM-YYYY")
          getFrom = itm.SenderName
      saveFolder = "C:Documents"
       
           For Each objAtt In itm.Attachments
           If InStr(objAtt.DisplayName, "nombreadjunto") Then
                objAtt.SaveAsFile saveFolder & "" & dateFormat & " - " & getFrom & " - " & objAtt.DisplayName
                Set objAtt = Nothing
                Set itm = Nothing
                End If
           Next
           
      End Sub
        • Buen dia

          Tienes que agregar las lineas para crear la carpeta con la fecha actual, seria algo asi.

          Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
          Dim objAtt As Outlook.Attachment
          Dim saveFolder As String
          Dim dateFormat
              dateFormat = Format(Now, "yyyy-mm-dd H-mm")
              
          Set fso = CreateObject("Scripting.FileSystemObject")
          
          saveFolder = "C:Archivos" & dateFormat & ""
          
          If Not fso.FolderExists(saveFolder) Then
              fso.CreateFolder (saveFolder)
          End If
               For Each objAtt In itm.Attachments
                    objAtt.SaveAsFile saveFolder & objAtt.DisplayName
                    Set objAtt = Nothing
               Next
          End Sub
    • que hace busca los archivos nombrados ahi y esos son los que guarda, en el momento de dar error solo dice error y ya no muestra codigo

      • Buen dia

        Mira podemos intentar utilizar el siguiente código para ver si nos da el error.

        Public Sub saveAttachtoDiskPrueba(itm As Outlook.MailItem)
        On Error Resume Next
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String
        Dim dateFormat
        Dim getFrom
        dateFormat = Format(Now, “DD - MM - YYYY”)
        getFrom = itm.senderName
        saveFolder = "C:Documents"
        
        For Each objAtt In itm.Attachments
        If InStr(objAtt.DisplayName, “nombreadjunto”) Then
        objAtt.SaveAsFile saveFolder & "" & dateFormat & " – " & getFrom & " – " & objAtt.DisplayName
        Set objAtt = Nothing
        Set itm = Nothing
        End If
        If Err.Number <> 0 Then
            WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " & Err.Description
            Err.Clear
        End If
        Next
        End Sub
        

        Si no, Elimina esta parte para intentar ignorar el error y continuar, me comentas ya que no he usado On Error Resume Next en vbscript en Outlook y no he podido replicar tu error para ver si efectivamente lo ignora o nos muestra el error.

        If Err.Number <> 0 Then
            WScript.Echo Err.Number & " Srce: " & Err.Source & " Desc: " & Err.Description
            Err.Clear
        End If

        Me comentas cualquier detalle para conocer si se aplico correctamente y ya tener este conocimiento :).

        Saludos.

    • Buen dia, me devolvio un error el titulo del error es Rules in Error, e indica lo siguiente:
      The Operation Fail.

      no devuelve codigo de error, solo indica eso. lo que no es que cuando recibi otros archivos que no eran el que esperaba paso eso. y despues deshabilita la Rule set.
      gracias por su atencion

    • El RuleSet esta si,

      On this computer only,
      Run a Script,
      el script seleccionado,

      nota: mi correo esta dentro del dominio de la compañia.

      • Buen dia

        No pude replicar tu error y hasta el momento no me ha tocado ver uno similar en uno de nuestros equipos posiblemente tenemos alguna diferencia en la versión de Office u Outlook, podemos intentar creado otra regla para que ejecute el siguiente script cada que llegue un correo, lo que hace este es activar la regla si se encuentra desactivada (solo especifica el nombre en el código)

        Public Sub EnableRule(itm As Outlook.MailItem)
        Dim olRules As Outlook.Rules
        Dim olRule As Outlook.Rule
        Dim intCount As Integer
        Dim blnExecute As Boolean
          
            Set olRules = Application.Session.DefaultStore.GetRules
            Set olRule = olRules.Item("NOMBREDELAREGLA")
            olRule.Enabled = True
            If blnExecute Then olRule.Execute ShowProgress:=True
             olRules.Save
           
            Set olRules = Nothing
            Set olRule = Nothing
        End Sub
        
    • hola, soy completamente nueva en esto de las macros, y tu solucion me viene muy bien, yo recibo diariamente 50 correos y debo descargar los adjuntos, la cuestion aqui es que por cada correo yo creo una carpeta nueva con su numero y nombre y en esa carpeta se guarda su adjunto. Ya tengo automatizada la parte de la creacion de las carpetas, solo me faltaria hacer la descarga de cada adjunto a su carpeta correspondiente. Es esto posible??

      Muchas gracias por la ayuda.

    • Agradecerte compartir este conocimiento, muchas gracias por personas altruistas al igual que yo ayudo a difundir sistemas, me ha servido realmente para solucionar un problema puntual. Comparto tu blog ya que veo mucho material muy interesante.

    • Disculpa, creo que debo aclarar que cada carpeta tiene un numero consecutivo el cual debe coincidir con el numero que tiene el subject del correo . Es decir si tengo 600 carpetas quiere decir que tengo 600 correos con numeracion 1, 2, ….

      • Buen dia

        Como automatizaste la creación de carpetas? Si utilizaste macro lo puedes publicar para analizarlo.
        Lo mas fácil modificar el Macro actual para que este pueda crear y guardar los archivos. te adjunto el macro modificado.

        Este macro crea carpetas y las nombra con el Subject de cada correo y guarda sus respectivos adjuntos esto dentro del folder especificado que es C:Documents (puedes cambiar la ruta a tu folder principal).

        Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String
        Dim getSubject
        destinationFolder = "C:Documents"
        getSubject = itm.Subject
        saveFolder = destinationFolder & getSubject
        
        'Objeto crear folder
        Set fso = CreateObject("Scripting.FileSystemObject")
        ' Crear Folder
        If Not fso.FolderExists(saveFolder) Then
        Set objFolder = fso.Createfolder(saveFolder)
        End If
        
             For Each objAtt In itm.Attachments
                  objAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName
                  Set objAtt = Nothing
             Next
        End Sub
        

        Nos comentas si te funciono,

        Si te gusta nuestro sitio Te agradeceríamos si nos regalas un like en Facebook 🙂

        • Buen día,

          Primero que todo quisiera agradecer que inviertas tu tiempo en ayudarnos con este tipo de consultas, eres genial, la macro que le enviaste a Andy para crear carpetas con el asunto del correo y guardar los respectivos adjuntos es la solución que estaba buscando, fantástica!. Pero tengo un inconveniente por algún motivo no funciona con los correos reenviados, revise la carpeta en destino a donde envía los adjuntos y todos los que tienen “RV: Asunto del correo” no quedaron guardados.

          • Buen dia Meliza!

            Se agrego una funcion al Script anterior para que se pueda generar las carpetas con los caracteres inválidos como son los dos puntos; Prueba el siguiente Script

            Public Sub saveAttachToSpecificFolder(itm As Outlook.MailItem)
            Dim objAtt As Outlook.Attachment
            Dim saveFolder As String
            Dim getSubject As String
            
            destinationFolder = "C:1-Tests"
            getSubject = itm.Subject
            ReplaceIllegalChars getSubject, "-"
            saveFolder = destinationFolder & getSubject
            
            'Objeto crear folder
            Set fso = CreateObject("Scripting.FileSystemObject")
            ' Crear Folder
            If Not fso.FolderExists(saveFolder) Then
            Set objFolder = fso.Createfolder(saveFolder)
            End If
             
                 For Each objAtt In itm.Attachments
                      objAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName
                      Set objAtt = Nothing
                 Next
            End Sub
              
            Private Sub ReplaceIllegalChars(getSubject As String, _
              sChr As String _
            )
              getSubject = Replace(getSubject, "/", sChr)
              getSubject = Replace(getSubject, "", sChr)
              getSubject = Replace(getSubject, ":", sChr)
              getSubject = Replace(getSubject, "?", sChr)
              getSubject = Replace(getSubject, Chr(34), sChr)
              getSubject = Replace(getSubject, "< ", sChr)
              getSubject = Replace(getSubject, ">", sChr)
              getSubject = Replace(getSubject, "|", sChr)
              getSubject = Replace(getSubject, "*", sChr)
            End Sub
            

            Muchas Gracias por los buenos comentarios 🙂

            Nos comentas los resultados, de ser posible en el siguiente Articulo que publicamos: VBScript – Guardar los Archivos Adjuntos en Carpetas Especificas Automáticamente Outlook.

            No olvides seguirnos en Facebook para que estes enterada de los nuevos artículos y soluciones que publiquemos.

            Saludos.

    • Mil Gracias, Son un Sol!!!!!… La solucion si funciona pero, hay algunos detalles, que supongo debi especificar. Te comento exactamente cual es mi proceso,. Es un poquito engorroso.
      Uso una plataforma llamada Constructware, en la cual por cada inspeccion se genera un documento llamado CRFI con su numero respectivo y el nombre correspondiente . Ej.BP-QF-02-06947 – Material Inspection on Silica Sand -Delmon Donde BP-QF-02-06947 es el numero del Documento y el resto el Nombre del mismo.
      Ahora, cuando se crea en el Constructware este envia un correo en el que
      From: Contraco QAQC
      Subjet: Contractor RFI No. BP-QF-02-06947 for Construction & Development of Golf Course (QF2) [BP-QF-02]
      (Donde BP-QF-02-06947 es el numero que va incrementando y el resto no se utiliza)

      Ahora, todos estos documentos se registran en un log en EXCEL que se genera de manera manual con otros datos que se Deben anexar.
      Y despues se crean las carpetas por cada uno de estos documentos con el numero y el titulo del documento, (el formato del nombre de la carpeta en este caso seria : BP-QF-02-06947 – Material Inspection on Silica Sand – Delmon ) y en la carpeta se guarda el archivo PDF que viene adjunto en el correo, al cual tambien se le cambia el nombre por el del numero correspondiente de documento ( en este caso el nombre original del documento es CRF-ME-198.pdf y en este caso al guardarlo en su carpeta se llamaria BP-QF-02-06947 )

      Bueno, a partir de ese log de Excel que ya se tiene, yo hice una Macro en Excel para generar un archivo BATy crear las carpetas nuevas con el formato deseado. Que son los siguientes:

      Sub creeTXT()
      
      Dim nombrearchivo, rutaarchivo As String
      Dim obj As FileSystemObject
      Dim ht As Worksheet
      Dim i, j, nfilas, ncolumnas As Integer
      
      
      nombrearchivo = "Sinespacios"
      rutaarchivo = ActiveWorkbook.Path & "" & nombrearchivo & ".bat"
      
      Set ht = Worksheets("Datos")
      Set obj = New FileSystemObject
      Set tx = obj.CreateTextFile(rutaarchivo)
      
      nfilas = ht.Range("A2", ht.Range("A2").End(xlDown)).Cells.Count
      ncolumnas = ht.Range("A1", ht.Range("A1").End(xlDown)).Cells.Count
      
      For i = 1 To nfilas
      For j = 1 To ncolumnas
      
      tx.Write ht.Cells(i + 1, j)
      If j < ncolumnas Then tx.Write vdtab
      
      Next j
      
      tx.WriteLine
      
      
      Next i
      
      End Sub
      

      Este me genera el siguiente archivo BAT

      @echo off
      CD C:/
      Y:
      CD Y:QFGC PDCC4.0 -ContractorQF 2 - CONTRACO11- CRFI's
      Dir
      MD "CRFI 06901 - Sand Surround & Installation of Warning Tape for Irrigation main pipe line @ Hole No.7 (18Holes CC)"
      MD "CRFI 06902 - Sand Surround & Installation of Warning Tape for Irrigation main pipe line @ Hole No.8 (18Holes CC)"
      MD "CRFI 06903 - Installation of Irrigation Heads (Swing arms & Sprinkler Heads) @ Hole No.6 (18holes CC) (Green Area"
      Pause
      Succesfull…Bye
      Pause
      Exit
      

      De esta manera ya genere cada una de las carpetas con el formato que necesito.

      Ahora, la macro que tu generaste esta genial, pero actualmente esta generando la carpeta con diferente extructura que es esta : Contractor RFI No. BP-QF-02-06947 for Construction & Development of Golf Course (QF2) [BP-QF-02]
      Y obvio no coincide con el formato que actualmente se tiene, es posible que las carpetas que se creen tengan el mismo formato que las anteriores?.. Aclaro que en los correos no se tiene el titulo de cada documento, unicamente el numero, es por eso que yo lo genere desde el Excel que tengo.

      Entonces, en el caso que se tengan que generar las carpetas como actualmente ya lo tengo , es posible que los adjuntos se bajen a las carpetas creadas anteriormente por el BAT ?… (se me ocurre que el correo haga un match entre los utlimos 5 digitos del numero y baje ahi su respectivo archivo..pero no se como hacerlo)

      Cada correo actualmente descarga dos archivos un HTML y un PDF, intente modificarlo para que bajara unicamente el PDF pero seguro puse la instruccion en el lugar equivocado porque no pude hacer que funcionara.

      Y la ultima pregunta, es posible tambien que al bajar el adjunto a la carpeta se cambie el nombre del archivo al numero que le corresponde??… es decir CRF-ME-198.pdf por BP-QF-02-06947.pdf

      Como te das cuenta ya tengo casi 7000 documentos y seguiran incrementando, esta tarea llego a mis manos hasta ahora y me quita muchisimo tiempo por la talacha que implica. Es por eso que quisiera automatizarlo lo mas que se pueda.

      Muchisimas gracias por sus aportaciones son muy funcionales.

      • Buen dia
        Ya comprendo lo que necesitas, si te doy la razon que es mejor que continúes creando la carpetas desde con el BAT que generas de Excel y de ser posible implementar en Outlook que busque la carpeta, requiero cierta información ya que quizas me enredé un poco:
        1.- ¿El numero BP-QF-02-06947 se va incrementando de la siguiente forma en cada correo (BP-QF-02-06948, BP-QF-02-06949, BP-QF-02-06950…)?
        2.- ¿Veo que el BAT genera la carpeta dentro de Y:QFGC PDCC4.0 -ContractorQF 2 – CONTRACO11- CRFI’s)?
        2.1 ¿Siempre es es 11- CRFI’s el directorio donde se crean las carpetas?
        2.2 ¿Del ejemplo de la carpeta: CRFI 06901 – Sand Surround & Installation of Warning Tape for Irrigation main pipe line @ Hole No.7 (18Holes CC) el numero 06901 es el consecutivo del nombre del archivo CRFI BP-QF-02-06907 correcto?
        3.- ¿El principio del subject “Contractor RFI No. BP-QF-02-” no cambia? Esto para el caso de poder eliminar/cortar los primeros 28 caracteres tomar los siguientes 5 y eliminar el resto. Ej: Solo tomar la parte marcada en negrillas de lo siguiente Contractor RFI No. BP-QF-02-06947 for Construction & Development of Golf Course (QF2) [BP-QF-02].

        Solo como comentario por si llego a tardar en dar respuesta ya que veo que posiblemente este caso sea un poco tardado, me gusta tener casos interesantes como este y aprender de estos. Asi que intentare estar dando seguimiento continuamente para dar solución solo que existe la posibilidad que sea un poco tardado ya que no puedo descuidar mi actual trabajo y dependo totalmente del tiempo que este me deje libre. El sitio es mi hobby.

    • Buen dia amigo el error continua, ahora hasta la subrutina de poner check a la regla da error no se que sea si alguna politica interna. continuare aplicando formas para evitar ese error. el correo esta en un servidor exchange de microsoft

      • Que raro, estuve buscando en Internet sobre el error y si le marca a muchas personas, lo que tienen en comun es Office 2007 y según les contestan que no es posible evitar que se desactive la regla. Aqui también manejamos los equipos en Dominio, Exchange 2010 y Office 2013, en otro tiempo disponible te voy a pasar otro código para intentar saltar el error, aun que es posible que se cree un ciclo por el tipo de error que te da (desconocido).
        Al momento podrías comentarnos que Office tienes para ir descartando posibles causas.

    • Muchas Gracias mi amigo, agradezco tu tiempo, cualquier cosa tienes mi correo personal. yo tambien soy desarrollador de aplicaciones y macros. cualquier cosa que pueda ayudar estamos a la orden.

    • Hola Buen Dia

      Por supuesto que entiendo tus tiempos , al contrario la verdad te agradezco que tu tiempo libre lo ocupes para ayudarnos a otros.

      Respondiendo a tus preguntas

      1.- ¿El numero BP-QF-02-06947 se va incrementando de la siguiente forma en cada correo (BP-QF-02-06948, BP-QF-02-06949, BP-QF-02-06950…)?

      * Si , de esa manera se incrementa

      2.- ¿Veo que el BAT genera la carpeta dentro de Y:QFGC PDCC4.0 -ContractorQF 2 – CONTRACO11- CRFI’s)?

      * Asi es, es el path y la carpeta 11- CRFI’s es la general donde se general de manera individual las carpetas por cada uno de los documentos

      2.1 ¿Siempre es es 11- CRFI’s el directorio donde se crean las carpetas?

      * Si, la carpeta nunca cambia

      2.2 ¿Del ejemplo de la carpeta: CRFI 06901 – Sand Surround & Installation of Warning Tape for Irrigation main pipe line @ Hole No.7 (18Holes CC) el numero 06901 es el consecutivo del nombre del archivo CRFI BP-QF-02-06907 correcto?

      * Exacto, cuando empezaron a almacenar la informacion en el servidor, para evitar largos nombres (que al final sucedio) abreviaron el numero del documento de CRFI BP-QF-02-06907 ( que es como llega en el correo) a solo CRFI 06907

      3.- ¿El principio del subject “Contractor RFI No. BP-QF-02-” no cambia? Esto para el caso de poder eliminar/cortar los primeros 28 caracteres tomar los siguientes 5 y eliminar el resto. Ej: Solo tomar la parte marcada en negrillas de lo siguiente Contractor RFI No. BP-QF-02-06947 for Construction & Development of Golf Course (QF2) [BP-QF-02].

      * Exacto el inicio nunca cambia y lo unico que siempre va a variar son los datos que tienes en negrillas, incluso el resto del subject tampoco varia y tampoco se utiliza.

      Muchas gracias por tu ayuda, comprendo que esto sera un proceso lento en el caso de que se pueda hacer algo. Por mi parte continuare leyendo y aprendiendo con prueba y error y si encuento algun detalle o dato que pueda ayudarte te lo hago saber. Gracias!!!! 🙂

      • Buen dia

        Me tarde un poco con algunos detalles pero por fin ya quedo, lo que hace el script es:
        1.- Toma 5 caracteres después del numero 29 quedando el consecutivo ej: 06947
        2.- Busca el folder que contenga el consecutivo
        3.- Guarda los archivos en la carpeta

        Para que funcione correctamente, el principio del correo no debe cambiar para que se puedan obtener exactamente los 5 dígitos del consecutivo, si llega a cambiar se debe ajustar.
        debes cambiar el directorio raiz en la linea 6 y en la linea 25 debes especificar la extensión del archivo que deseas guardar, te dejo el script 🙂 nos comentas como te funciona.

        Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String
        Dim getSubject
        Dim finalSubject
        Const strDir = "C:1-Tests"
        Set fso = CreateObject("Scripting.FileSystemObject")
        ' get Subject
        getSubject = itm.Subject
        ' get part of the subject: start in 29 and get the next 5
        finalSubject = Mid(getSubject, 29, 5)
        
        ' start to search for a directory
        strFlag = finalSubject
        saveFolder = findFolder(strDir, strFlag)
        
        ' Error message if directory doesn't exist
        If Not fso.FolderExists(saveFolder) Then
            MsgBox "Doesn't exists."
        End If
        ' Save in the located directory
                      
             For Each objAtt In itm.Attachments
             ' Add save only a type of file
                If InStr(objAtt.DisplayName, ".txt") Then
                  objAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName
                  Set objAtt = Nothing
                End If
             Next
        End Sub
        
        Function findFolder(strDir, strFlag)
        Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objFolder = objFSO.GetFolder(strDir)
            For Each objSubFolder In objFolder.SubFolders
                If (InStr(objSubFolder.Name, strFlag)) Then
                    findFolder = objSubFolder.Path
                    Exit Function
                Else
                    findFolder = findFolder(objSubFolder.Path, strFlag)
                    MsgBox " exists."
                End If
           Next
        End Function
        
        • Hola!, Al contrario agradezco que te tomes tu tiempo para ayudarme con este lio. Mil disculpas por tardar tanto en contestar habia estudo muy ocupada y no habia tenido la oportunidad de probar con calma el script.

          Fijate que no me funciona, cuando lo copio en VSB apartir de la linea 32 me hace la division como si iniciara otro script diferente.

          Intente correrlo asi y por lo que alcanzo a comprender de la function que se describe en la linea 32, al ejecutar la regla se queda en un bug donde solo busca el folder y envia una ventana de “exist” n veces y debo cerrar outlook para que pare.

          Por lo que comprendo al dividirlo unicamente ejecuta apartir de la linea 31

          Intente mover ese bloque hacia la linea 16 pero no se ejecuta 🙁

          Mil Gracias por tu tiempo, y de Nuevo mil disculpas por tardarme. 🙂

          • Buen dia

            Se me paso eliminar la linea 41 que dice MsgBox ” exists.”., eliminala y ya no pasara.

            No es error lo que hace te lo muestra cada que revisa una carpeta y como tienes miles por eso parece que se cicla en error, este mensaje era para guiarme yo.

            Nos comentas como te funciona, Saludos.

          • Hola buen dia,

            Fijate que no funciona, le elimine la linea 41 como me indicaste, y si en efecto ya no sucede lo anterior.

            Pero solo se queda como “ejecutandolo” termina y cuando reviso las carpetas no bajo ningun archivo.

            Se ve que hace algo pero no los Baja.

            Te lo envio, pero realmente las unicast modificaciones que tiene son las del path y el tipo de archivo.

            Gracias y disculpa por tanta lata. 🙂

            Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
            Dim objAtt As Outlook.attachment
            Dim saveFolder As String
            Dim getSubject
            Dim finalSubject
            Const strDir = "Y:QFGC PDCC4.0 -ContractorQF 2 - CONTRACO11- CRFI'sprueba"
            Set FSO = CreateObject("Scripting.FileSystemObject")
            ' get Subject
            getSubject = itm.Subject
            ' get part of the subject: start in 29 and get the next 5
            finalSubject = Mid(getSubject, 29, 5)
             
            ' start to search for a directory
            strFlag = finalSubject
            saveFolder = findFolder(strDir, strFlag)
            
            
            ' Error message if directory doesn't exist
            
            If Not FSO.FolderExists(saveFolder) Then
            
               MsgBox "Doesn't exists."
            End If
            
            ' Save in the located directory
            
             For Each objAtt In itm.Attachments
                 ' Add save only a type of file
                    If InStr(objAtt.DisplayName, ".pdf") Then
                      objAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName
                      Set objAtt = Nothing
                    End If
                 Next
            
            End Sub
            
            Function findFolder(strDir, strFlag)
            Set objFSO = CreateObject("Scripting.FileSystemObject")
                Set objFolder = objFSO.GetFolder(strDir)
                For Each objSubFolder In objFolder.SubFolders
                    If (InStr(objSubFolder.Name, strFlag)) Then
                        findFolder = objSubFolder.Path
                        Exit Function
                    Else
                        findFolder = findFolder(objSubFolder.Path, strFlag)
                        
                    End If
               Next
               
            End Function
            
          • Buen dia

            Mira en un principio hice la prueba con 2 carpetas en el directorio raíz para asegurarme que buscara y guardara los archivos, realice nuevamente pruebas por lo que me comentas y lo hice con 15 carpetas de prueba y si me localiza y guarda los archivos, lo que no habia pensado es; si tienes miles de carpetas en el directorio este recorre todas para consultar el nombre el cual le puede llevar tiempo (no podria calcular cuanto), pensaría en agregar un filtro de búsqueda por rango de fechas pero de igual forma se tendría que leer las propiedades de cada carpeta el cual calculo que tomaría el mismo tiempo en recorrerlas, la cantidad de carpetas es la que no se considero desde un principio, la carpeta prueba tiene carpetas dentro?
            ocuparía saber cual es el entorno en el cual lo estas probando ya que no pude replicar lo que me comentas hasta el momento.

    • Gracias por la los ejemplos.. pero no e logrado que se ejecuten ni uno de los ejemplos. al ingresar la regla me muestran el siguientes mensaje:
      La regla tiene una condición que el servidor no puede procesar. La acción ” Detener el proceso de mas reglas” evitara que las reglas restantes del servidor se lleven acabo. ¿ Esta seguro que es esto lo que desea hacer?.

      le doy aceptar y nunca ejecuta la regla, tengo la versión 2013 y trabajo en una corporación tienen un montón de seguridad informática no se si deba a esto. Favor estaré muy agradecido con tu ayuda.

      Nota. también habilite la configuración de las macros

      • Buen dia Miguel,

        No es requerido tener privilegio de administrador en el equipo, al menos que en la empresa esten bloqueando que ejecuten scripts en los equipos por medio de GPO (Group Policy Object) del dominio ya que comentas que tienen bastante seguridad.

        Podemos comenzar con algo basico intentando con un script que simplemente te muestre un mensaje de prueba, en el modulo pon solamente este codigo y cambia el script en la regla.

        Public Sub Prueba(itm As Outlook.MailItem)
            MsgBox "Prueba"
        End Sub
        

        Respecto al error “La regla tiene una condición que el servidor no puede procesar. La acción ” Detener el proceso de mas reglas” evitara que las reglas restantes del servidor se lleven acabo.” siempre lo muestra ya que estas reglas no se pueden ejecutar/guardar desde el servidor exchange porque contienen un script que se ejecuta localmente en el equipo.

        Nos comentas si el código de prueba si lo ejecuta.

    • Hola, que tal, me ha dado buenos resultados tu Script, gracias por este truco tan util, pero quiero saber si hay forma de guardar todos los mensajes de una cuenta debido a que se va a cambiar el dominio, necesito hacer un backup de TODO lo de esa cuenta, desde lo muy viejo hasta lo de hoy, hay manera?
      te agradezco de antemano.

      • Buen dia

        Si se puede respaldar todo el Mailbox (Correos, contactos, calendario, etc.) Para esto te diriges a File (Archivo) > Open & Export (Abrir y Exportar) > Import/Export (Importar/Exportar). Te va a abrir una ventana que te dara las opciones, seleccionas Export to a File (Exportar a Archivo) das Siguiente, seleccionas Outlook Data File (.pst) [Archivo de datos de Outlook] y das siguiente ahora seleccionas el Mailbox o lo que vayas a exportar y asegurate que este seleccionado include subfolders (incluir subfolders) para que se respalde todo. dar siguiente y te dara la opción de guardar.

        En la siguiente semana publicaremos un articulo para realizar el respaldo.

        Cualquier consulta no dudes en preguntarnos, Saludos.

    • Hola buen dia!!

      Lo ejecute la carpeta 11- CRFI’s que en realidad es donde se encuentran las carpetas individuales, en la que actualmente ya son 7210 e incrementa 30 o 40 por dia. Deje el script corriendo y se tardo casi toda la noche. esta carpeta esta en el servidor de ahi el path Y:QFGC PDCC4.0 -ContractorQF 2 – CONTRACO11- CRFI’s

      Ahora, la carpeta PRUEBA yo la cree precisamente para eso, para realizer ahi todas las pruebas con este rollo, y si copie algunas carpetas ahi dentro son un total de 20 y no bajo ninguno.

      Te explico lo que hice, cree la carpeta PRUEBA y copie algunas carpetas (20). las cuales por supuesto el numero coincide con el numero del subject del email.

      Despues, hice una regla en el outlook, en la que todos los emails marcados con categoria color Azul, se ejecuta el script.

      Cambie el path hacia ambas carpetas, la de prueba y la real, la diferencia fue en que en la de prueba se ve que se esta ejecutando pero no Baja los archivos y termina en un minuto. Cuando lo ejecuto en la carpeta 11-CRFI que es donde estan todas . precisamente por lo que tu dices, se queda ahi horas y hasta que temina pero igual no Baja ningun correo.

      Voy a intentar con 15 y te comento que sucede.

      Gracias 🙂

      • Buen dia

        Es una lastima que no te este funcionando, deberia haber funcionado en la prueba que hiciste, lo que estaba pensando que sea algún problema de permisos de la carpeta compartida con Outlook ya que yo las pruebas las hice en una carpeta local, aun que no deberia ya que si con tu usuario no tienes problemas para entrar a la carpeta debe funcionar, para descartar eso podrías esa misma prueba realizar en una carpeta local por ejemplo copia tu carpeta prueba al C: de tu PC y cambia la ruta en el script de igual forma deberían poder ser 200 ~ 300 y no tardar tanto en realizar la búsqueda también ocupo saber que datos esta tomando, para esto después de la linea 16 pon la siguiente linea:

        'Mensaje para mostrar los valores que toman las variables
        
        MsgBox ("Subject: " & getSubject & vbCrLf & "FinalSubject: " & finalSubject & vbCrLf & "strDir: " & strDir & vbCrLf & "strFlag : " & strFlag & vbCrLf & "saveFolder: " & saveFolder)
        
        

        Y me envias lo que te muestre el mensaje.

        Saludos.

        • hola 🙂

          Hice la carpeta en mi PC y no los Baja, si se ejecuta pero no los baja. Lo que hize fue crear la carpeta en mis Documentos, y copie solo 27 carpetas dentro.

          Me envia dos mensajes, el primero dice solo EXIST y el Segundo envia esto:

          Subject: Contractor RFI No. BP-QF-02-07138 for Construction & Development of Golf Course (QF2)[BP-QF-02]
          FinalSubject: 07138
          strDir: C:UsersaalvaradoDocumentsPrueba
          strFlag: 07138
          saveFolder: C:UsersaalvaradoDocumentsPruebaCRFI 07138 – Closing of JSI No. BP-QF-02-0129 Incorrect Sand Mat Inst

          Esto lo envio solo para las 27 carpetas que copie a la carpeta prueba, pero no bajo el archivo.

          Para el resto de correos que no existe su carpeta correspondiente, solo envio EXIST

          Gracias!!! 😉

          • Buen dia

            Creo que se agotaron mis ideas el porque no funciona en tu equipo, realice pruebas con 50 carpetas y archivos .pdf y me funciona perfecto incluso no tarda mas de 10 segundos en localizar la carpeta y guardar los archivos, incluso realice la prueba con varios archivos .xls, .txt, pdf.

            Tu archivo a guardar si es .pdf?

            Ahora mira realice 2 modificaciones, el primero es para hacer nuevamente una prueba solo cambia la ruta de la carpeta, este va a guardar todos los adjuntos
            La Opción 2 Sigue guardando solo PDFs pero le integre si no encuentra la ruta que la consulte y se ponga manual, espero tus comentarios.

            Opción 1

            Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
            Dim objAtt As Outlook.Attachment
            Dim saveFolder As String
            Dim getSubject
            Dim finalSubject
            Const strDir = "C:1-Tests"
            Set FSO = CreateObject("Scripting.FileSystemObject")
            
            ' get Subject
            getSubject = itm.Subject
            ' get part of the subject: start in 29 and get the next 5
            finalSubject = Mid(getSubject, 29, 5)
            
            ' start to search for a directory
            strFlag = finalSubject
            saveFolder = findFolder(strDir, strFlag)
            
            ' Save in the located directory
            If FSO.FolderExists(saveFolder) Then
                For Each objAtt In itm.Attachments
                      objAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName
                      Set objAtt = Nothing
                 Next
            Else
            ' Error message if directory doesn't exist
                MsgBox "Folder Doesn't exists."
                
            End If
                           
            End Sub
            
            Function findFolder(strDir, strFlag)
            Set objFSO = CreateObject("Scripting.FileSystemObject")
                Set objFolder = objFSO.GetFolder(strDir)
                For Each objSubFolder In objFolder.SubFolders
                    If (InStr(objSubFolder.Name, strFlag)) Then
                        findFolder = objSubFolder.Path
                        Exit Function
                    Else
                        findFolder = findFolder(objSubFolder.Path, strFlag)
                    End If
               Next
            End Function
            

            Opción 2

            Option Explicit
                   Dim StrSavePath     As String
            Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
            Dim objAtt As Outlook.Attachment
            Dim saveFolder As String
            Dim FSO As Object
            Dim strFlag As String
            Dim getSubject As String
            Dim finalSubject As String
            
            Const strDir = "C:1-Tests"
            Set FSO = CreateObject("Scripting.FileSystemObject")
            ' get Subject
            getSubject = itm.Subject
            ' get part of the subject: start in 29 and get the next 5
            finalSubject = Mid(getSubject, 29, 5)
            
            ' start to search for a directory
            strFlag = finalSubject
            saveFolder = findFolder(strDir, strFlag)
            
            If FSO.FolderExists(saveFolder) Then
            ' Save in the located directory
                 For Each objAtt In itm.Attachments
                     ' Add save only a type of file
                        If InStr(objAtt.DisplayName, ".pdf") Then
                        objAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName
                        Set objAtt = Nothing
                        End If
                     Next
            Else
                ' MsgBox "Folder Doesn't exists."
            'Search for Folder Manually
                BrowseForFolder saveFolder
            ' Save in the located directory
                     For Each objAtt In itm.Attachments
                     ' Add save only a type of file
                        If InStr(objAtt.DisplayName, ".pdf") Then
                        objAtt.SaveAsFile saveFolder & "" & objAtt.DisplayName
                        Set objAtt = Nothing
                        End If
                     Next
            End If
            End Sub
            
            
            Function findFolder(strDir, strFlag)
            Dim objFSO As Object
            Dim objFolder As Object
            Dim objSubFolder As Object
            Set objFSO = CreateObject("Scripting.FileSystemObject")
                Set objFolder = objFSO.GetFolder(strDir)
                For Each objSubFolder In objFolder.SubFolders
                    If (InStr(objSubFolder.Name, strFlag)) Then
                        findFolder = objSubFolder.Path
                        Exit Function
                    Else
                        findFolder = findFolder(objSubFolder.Path, strFlag)
                    End If
               Next
            End Function
            
            Function BrowseForFolder(saveFolder As String, Optional OpenAt As String) As String
                Dim objShell As Object
                Dim objFolder '  As Folder
             
            Dim enviro
            enviro = CStr(Environ("SYSTEMROOT")) 'USERPROFILE
            Set objShell = CreateObject("Shell.Application")
            Set objFolder = objShell.BrowseForFolder(0, "Selecciona una Carpeta", 0) ', enviro & "Documents")
            saveFolder = objFolder.self.Path
             
                On Error Resume Next
                On Error GoTo 0
                   
            ExitFunction:
                Set objShell = Nothing
                   
            End Function
            
          • Hola buen dia,

            Si mi archivo a guardar es .pdf, pero el email viene con un htm y el pdf . Por eso necesito especificar el tipo del archivo que quiero.

            Ahora, ejecute los dos scripts que enviaste, en el primero funciona perfectamente y Baja ambos archivos (htm y pdf) del email en su carpeta que corresponde.

            El Segundo, solicita la ruta en la que se desea guardar el archivo en caso de no encontrar el folder, pero como no muestra cual numero es el que esta solicitando pues no hay manera de guardarlo, y de las carpetas que si existe el numero no guarda los archivos.

            Mil Gracias 🙂

          • Buen dia

            Entonces partiendo de la primera opción sabemos que si funciona el Script pero no guarda los archivos cuando especificas la extensión del archivo, nos podremos asegurar que los archivos son exactamente PDF y no otro formato soportado por los lectores/editores PDF? Si no es información confidencial o sensible podrías hacer forward de algún correo de los que recibes a [email protected] para poder verificar tu archivo y hacer pruebas con un correo real.

            Saludos.

    • Hola, he probado los scripts y funciona a la perfección, en un proyecto necesitaba extraer unos archivos zip de unos correos enviados automaticamente por una plataforma web y he podido diferenciar el contendio sin problemas, gracias por la aportación.

      Un comentario , un poco tonto, ¿existe forma de que el script funcione sin estar el cliente Outlook abierto?, ¿sería a nivel de servidor? , si es así ¿teneis alguna información?

      Gracias

      • Buen dia Raul

        No me habia surgido la pregunta que nos haces, he investigado ahorita un poco ya que no tenia conocimiento al respecto y dependiendo el servidor de correos y si es Exchange tambien dependiendo de la versión, en si, los scripts del articulo estan escritos para funcionar del lado del cliente, mas no he probado si se puede del lado del servidor en base a la información que te adjunto a continuación:

        Te hago copia de un articulo publicado en el sitio oficial de Microsoft:

        Client-side rules developer technologies:

        Rules Wizard “Run a Script” rules
        Outlook Visual Basic for Applications solutions
        Outlook COM add-in solutions
        Custom Actions for the Rules Wizard
        Exchange SDK Rule Component (Rule.dll)

        Server-side rules developer technologies:

        Exchange Server 5.5 Scripting Agents
        Exchange 2000 Server Event Sinks
        Exchange SDK Rule Component (Rule.dll)

        Fuente

        Utilizando Exchange Server Scripting Agents en el articulo de OutlookCode mencionan que tambien se utiliza VBSicript y JScript (Ver Articulo) seria interesante probar si estos scripts publicados se pueden ejecutar del lado del servidor lastima que en la empresa no tenemos los modulos activos por seguridad.

        Saludos.

          • Buen dia

            Es una lastima que no le permitan hacer uno de Scripts / Macros por la seguridad; ya que si son de bastante utilidad.

            No dude en visitarnos nuevamente por cualquier consulta.

    • Buenas,

      Yo he creado otro script que necesitaba, aunque la base es muy parecida ( lo ejecuto seleccionando correos ya que en el script uso dichos seleccionados ). El caso, es que cuando voy a configurar la macro para que se ejecute automáticamente para los correos que vaya a recibir ( con el wizard que describes para configurar una regla con la macro creada ), al llegar a la última opción de “Script”, pincho, y no me sale en la ventanita para elegirlo ( sólo tengo uno creado ), es decir, la lista la tengo vacía.

      Ya he configurado que permita todas las macros, y esa macro, sin tenerla en una regla, la he probado y funciona, ¿ se te ocurre porqué no la veo ?.

      Muchas gracias y un saludo.

    • Hola Buenas Tardes, antes que nada agradezco mucho tu ayuda al realizar este post, quisiera un poco de mas apoyo con esta duda y poder seguir utilzando los Script que ya tienes:

      Duda: Me llegan varios archivos .msg (20 o 30 o mas) en un solo e-mail y dentro de cada .msg se encuentra los archivos .pdf y .xml, deseo sacar de los .msg los .pdf o .xml o ambos utilizando los scripts que ya tienes pero no se la modificacion que habria que realizarle al que ya utilizo.

      Saludos

    • Hola,
      Primero que todo muchas gracias por publicar estos códigos , me fueron de gran ayuda.
      Quisiera saber si es posible que los archivos adjunto se guarden con la fecha del correo enviado

      Gracias de antemano.

      • Buen dia Marcelo

        Disculpa no comprendo cual flecha, te refieres al que indica si respondiste el correo, hiciste forward, etc? si te refieres a esa no se puede guardar en nombre del sistema ya que es un icono.

        Saludos.

      • Buen dia

        Los códigos de estos artículos guardan automáticamente los adjuntos de cada correo recibido, es por eso que se debe configurar una regla para que lo ejecute cada que se recibe un correo (Explicado en el articulo).

        Saludos.

    • hay proveedores que envian los xml y pdf comprimidos en un zip, como podria hacer q los descomprima y guarde como en el Scrip ya dado con fecha y quien envio, solo agregandole q si es un zip lo descomprima .

    • Buenos días,

      En el outlook 2010 tengo agregadas varias cuentas pero solo necesito que se copien a mi equipo los adjuntos de solo una de ellas ¿Cómo lo hago?

      Muchísimas Gracias!

      • Buen dia Jose!

        Al momento de generar la regla en las condiciones que quieres debes seleccionar Through the specified account (A través de la cuenta especificada) te aparecerá un listbox donde te muestra tus cuentas dadas de alta en Outlook.

        Saludos.

    • Buen día!!!

      Les agradecería muchñisimo que me pudieran ayudar con un detalle que tengo con el outlook 2013, lo que yo requiero es que al llegar un correo de un usuario especifico se impriman los datos adjuntos de manera automática, ¿hay algún scrip para realizar esta función?

      Muchas gracias.

      Saludos y buen día!!

    • Hola buenas, muchas gracias por el script ha funcionado a las mil maravillas, daros las gracias por la información y por paginas webs como la vuestra, quería preguntaros, necesitaba una modificación de ese script, necesitaba guardar el texto del email en un archivo txt en una carpeta ¿Cómo seria el script? . Muchas gracias y enhorabuena otra vez por vuestra web y ayuda. Un saludo

    • Hola!
      Me aparece el siguiente mensaje “Esta regla es una regla sólo de cliente y sólo se procesará cuando se esté ejecutando Outlook”. y no me está guardando los adjuntos. Ocupe el siguiente código:
      Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
      Dim objAtt As Outlook.Attachment
      Dim saveFolder As String
      saveFolder = “D:Prueba Macro CorreosHESA”
      For Each objAtt In itm.Attachments
      If ((InStr(objAtt.DisplayName, “.xml”) Or InStr(objAtt.DisplayName, “.pdf”))) Then
      objAtt.SaveAsFile saveFolder & “” & objAtt.DisplayName
      End If
      Next
      End Sub

      • Buen dia

        El mensaje que te muestra es solo una alerta el cual te esta indicando que la regla solo se puede procesar del lado del cliente y debe estar abierto outlook (Siempre marca ese mensaje cuando ejecutan un script ya que este no se guarda en el servidor de correos). Utiliza el siguiente código, se agrego UCase() ya que si tus archivos estan en mayúsculas no los reconocía, en este momento ya reconoce mayúsculas y minúsculas (Convierte las minúsculas a mayúsculas).

        Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String
        saveFolder = “D:Prueba Macro CorreosHESA”
        For Each objAtt In itm.Attachments
        If (InStr(UCase(objAtt.DisplayName, “.XML”)) Or InStr(UCase(objAtt.DisplayName, “.PDF”))) Then
        objAtt.SaveAsFile saveFolder & “” & objAtt.DisplayName
        End If
        Next
        End Sub
        • Muchas gracias por tu respuesta y por el aporte! recién estoy aprendiendo macros así que sirve mucho.
          Lo quiero aplicar en algo mucho mas grande, así que estoy definiendo bien el problema global para luego consultar.
          Gracias

          • Buen dia Fernando, el problema anterior lo pude resolver, pero ahora tengo una incognita resulta que quiero crear mas modulos para que ciertos correos de remitentes se vayan a carpetas especificas, pero al momento de poner la relga de “run script” estos no me aparecen, o solo me aparece el project1VBA y no me da la opcion de seleccionar uno de los modulos que cree; Porfavor agradeceria su respuesta.

    • Hola, buenos días, Muchas gracias e infinitas gracias por el aporte. Tengo una consulta: La semana pasada hice el proceso para ejecutar uno de los script en dos PC y me funcionó de maravilla, sin embargo después de una semana dejaron de funcionar, así sin más. Ahora no sé qué hacer, ya revise que todo estuviera en activo, lo re intente y nada. Agradecería mucho la ayuda que puedan brindarme. saludos.

      • Buen dia

        En algunas ocasiones puede ser a causa de una actualización el cual active la seguridad en Macros, etc. revisa la configuración del siguiente articulo , realizaste modificación al script?

          • Buenas, a mi me funcionaba perfecto, no he modificado nada en el script más que la carpeta y ya no me funciona…. No sé como modificar lo de la seguridad en macros y tal…

          • He hecho lo de la seguridad en macros y aún así no me funciona… y me ha funcionado un par de días… es verdad que he actualizado el office…

          • Buen dia Alejandro.

            Verifica que este activo el Add-in “Microsoft VBA for Outlook Addin”, este lo encuentras en File (Archivo) > Options (Opciones) > Add-Ins, si no se encuentra el que te mencionamos anteriormente a nuestra experiencia se tendria que desinstalar y reinstalar Outlook, puedes encontrar otras opciones de importar el DLL etc pero no nos ha funcionado, de igual forma lo puedes intentar.

            Saludos.

    • Hola…. muy bueno el articulo… una consulta, habrá algo similar pero para correos GMAIL?

      Espero tu pronta respuesta….!!!

      Saludos,

      • Buen dia Luis!

        Lamentablemente Gmail no incorpora alguna funcion para ejecutar VBScripts; esto tiene que ser desde el algún cliente por ejemplo MS Outlook el cual si deseas implementarlo puedes configurar tu cuenta de Gmail y en este generar las reglas con los Scrips aquí mencionados.
        Si tienes mas consultas no dudes en escribirnos.
        Saludos.

        • Gracias por tu respuesta… Creo que por el momento intentare exportar mis correos de GMAIL a OUTLOOK y con el scrip descargar los archivos en automático… Espero funcione y no tenga inconvenientes.

          Saludos,

    • Hola! Gracias por el aporte. Aprovecho de consultar por otra cosa. Quiero guardar correos de outlook en word, varios correos en un archivo word. habrá alguna manera de hacerlo con macros? Desde ya, muchas gracias!

    • Hola,
      Para probar, utilicé la macro que guarda los correos como texto que encontré aquí https://www.portalmastips.com/vbscript-guardar-correos-seleccionados-en-archivo-txt-outlook/.
      si cambio .txt por .doc guarda el correo en formato word, pero un word para cada uno de los correos. Yo quiero un archivo word con todos los correos guardados en una carpeta y también si es posible darle un formato específico al archivo. Te agradecería mucho si me pudieras ayudar con eso.

      Saludos

      • Buen dia Cari

        Te dejo el siguiente articulo VBScript – Guardar Correos Seleccionados en un mismo Archivo Doc (Word) donde guarda los correos seleccionados en el mismo documento, pero si pierden el formato ya que al momento de hacer la union se lee el texto y queda como texto plano. Favor de seguir comentarios en el articulo que te anexamos.

        Respecto a cambiar el formato no se puede aplicar directamente ya que en si se esta forzando a Word a leer un documento TXT; te podria ayudar para guardar cada correo en un archivo doc en RichTextFormat (o que mantenga el formato en el que fue recibido).

        En otro momento que tenga libre voy a realizar una modificación a unos Scripts que tengo para ver si se puede hacer el merge con otro metodo.

        Quedamos en espera de tus comentarios.

        Saludos.

    • Estimado, muy buen aporte gracias, pero tengo un problema, al cerrar el correo pregunta si desea guardar el proyecto, le puse si, pero al volver a abrir el correo ya no ejecuta la regla siendo que esta activa y al presionar Alt+F11 muestra que se encuentran creados los script, favor su ayuda

      • Buen dia Pablo,
        Elimina el Modulo en el editor de visual basic, agregalo nuevamente, pega el codigo VBScript has la modificación requerida y lo guardas, la seleccionas nuevamente en la regla que generaste; tambien debes asegurarte si tienes otros VBScript que no se repita el nombre.
        Nos comentas si ya te permitio ejecutar.

        Saludos.

    • Buenos dias
      Tengo un problema en outlook 2010 lo que pasa es que tenia la version 2007 y lo actualice a 2010 el problema es que cuando abro un archivo adjunto ….me sale
      “error en la operacion” y se daña el archivo adjuntado ya lo reinstale varias veces y nada

      espero que me ayuden

    • hola Portal Tips tengo usando el avast y el firewall lo tengo desactivado la verdad no se por que los archivos adjuntos se me dañan al abrirlo ejemplo archivo.pdf 138kb y al abrirlo error en la operacion y el archivo se daña archivo.pdf 138 b osea a bit?? por que apenas boy a checar lo que me mandastes

      • Buen dia Mario!

        Una vez que intentes lo mencionado en los artículos si continua la problemática, puedes hacer la prueba si entrar por OWA / revisar tu correo en linea verificar que los adjuntos no lleguen dañados, que sea algun firewall que los este dañando antes de entregarlos al cliente.

        Nos confirmas.

        • Hola Buenos dias Fernando acerca del owa mi correo no es hotmail ni gmail es de correo de la propia empresa
          entonces hice proceso y de que sale el error en la operacion /// haciendo una carpeta temporal (temp0) desde el registro de windows regedit

          Outlook 2010

          Si está utilizando Outlook 2010, siga estos pasos:
          Haga clic en Mi PC y, a continuación, haga doble clic en la unidad C:.
          En el menú archivo, haga clic en nuevo y, a continuación, haga clic en carpeta.
          Nombre a la carpeta temp0.
          Haga clic en Inicio, haga clic en Ejecutar, escriba regedit y, a continuación, haga clic en Aceptar.
          Busque y, a continuación, haga clic en la clave del registro siguiente:
          HKEY_CURRENT_USERSoftwareMicrosoftOffice14.0OutlookSecurity
          En el panel derecho, haga doble clic en OutlookSecureTempFolder.
          En el campo Información del valor, escriba C:temp0 y, a continuación, haga clic en Aceptar.
          Salga del Editor del Registro.
          Reinicie el equipo.

          Fernando esto me ayudo a que los archivos no se dañen …pero el problema es que sigue apareciendo error en la operacion al abrir un archivo adjunto o pdf o excel o word y ala segunda que lo abro se abre el documento.

          • Buen dia

            Gracias por confirmarnos de la solución Mario, entonces es problema son los permisos con tu servidor de correos; estan utilizando MS Exchange o que servidor de correos utilizan, esto solo te pasa a ti? dependiendo la configuración que utilicen si utilizan AD falta que te pongan en algun grupo donde te den los Privilegios requeridos.

            De igual forma me complace saber que ya has solucionado tu inconveniente.

            Saludos.

    • Hola fernando
      no uso ms exchange y me ha pasado en 8 pc batallando por quitar ese error de operacion al abrir el archivo adjunto se reinstalo el office o tambien lo desinstale hasta hice formato ..y sigue ese mensaje pero lo curioso es que no importe el archivo pst hice uno nuevo pero salio el mismo error “error en la operacion”

      alguna sugerencia para modificar algo en el outlook 2010

      • Buen dia

        Necesito saber que servidor de correo utilizas, si es propio o lo contratan con un 3ro?
        Esto por lo que he visto en sitios es por configuración de permisos por parte del servidor.

        Segun Microsoft: Guarda los datos adjuntos como un archivo temporal. El archivo se guarda en la carpeta archivos temporales de Internet en una carpeta con un nombre aleatorio (en tu caso temp0, etc.). Cuando se configuran perfiles móviles (en tu caso los clientes outlook), la carpeta archivos temporales de Internet se almacena en el perfil del usuario en un servidor. El usuario obtiene acceso a la carpeta en la red.

        Es por eso que se requiere saber que servidor de correos utilizan (nombre de aplicación y SO del servidor) a lo que veo esto se tiene que solucionar del lado del servidor y no de los clientes (MS Outlook)

    • Hola buen día, tu post es de gran ayuda, sólo que quiero implementarla de una manera un poco distinta, ya que no me importan tanto los adjuntos, sino que quiero tener en un Excel los campos como REMITENTE, ASUNTO, FECHA, MENSAJE de todos los mensajes que me lleguen dada una regla, por ejemplo en el asunto.
      Creo que mi problema está en que no sé como decirle que lo haga para todos los mensajes que ingresan, puse For Each correo In itm.MessageClass
      donde correo es Dim correo As Outlook.MailItem
      y itm lo define en el procedimiento como my_proc(itm As Outlook.MailItem)
      espero que me puedas dar alguna idea, saludos.

      • Buen dia Juan

        Prueba el siguiente codigo de Diane Poremsky y a partir de este comenzamos a realizar las modificaciones, danos oportunidad de crear un nuevo articulo con la explicación del funcionamiento de este codigo y ahi continuamos los detalles para que nos escribas si es algo parecido a lo que requieres, puedes seguirnos en Facebook para que te percates cuando publiquemos el articulo durante la semana.

        para utilizar el codigo solo busca las siguientes 2 lineas:
        Debes crear primero un archivo Excel llamada test por ejemplo donde se van a guardar los detalles que mencionas en el C: o en la siguiente linea especifica manualmente la ruta y el nombre del archivo.
        strPath = “C:test.xlsx”

        Tambien debes especificar en la siguiente linea cambiar el Test por el nombre de la hoja de Excel donde se guardaran los detalles.
        Set xlSheet = xlWB.Sheets(“Test”)

        Option Explicit
         Sub CopyToExcel()
         Dim xlApp As Object
         Dim xlWB As Object
         Dim xlSheet As Object
         Dim rCount As Long
         Dim bXStarted As Boolean
         Dim enviro As String
         Dim strPath As String
         
         Dim currentExplorer As Explorer
         Dim Selection As Selection
         Dim olItem As Outlook.MailItem
         Dim obj As Object
         Dim strColB, strColC, strColD, strColE, strColF As String
                        
        ' Get Excel set up
        enviro = CStr(Environ("USERPROFILE"))
        'the path of the workbook
         strPath = "C:1-Teststest.xlsx"
             On Error Resume Next
             Set xlApp = GetObject(, "Excel.Application")
             If Err <> 0 Then
                 Application.StatusBar = "Please wait while Excel source is opened ... "
                 Set xlApp = CreateObject("Excel.Application")
                 bXStarted = True
             End If
             On Error GoTo 0
             'Open the workbook to input the data
             Set xlWB = xlApp.Workbooks.Open(strPath)
             Set xlSheet = xlWB.Sheets("Test")
            ' Process the message record
             
            On Error Resume Next
        'Find the next empty line of the worksheet
        rCount = xlSheet.Range("B" & xlSheet.Rows.count).End(-4162).Row
         
         
        ' get the values from outlook
        Set currentExplorer = Application.ActiveExplorer
        Set Selection = currentExplorer.Selection
          For Each obj In Selection
         
            Set olItem = obj
            
         'collect the fields
            strColB = olItem.senderName
            strColC = olItem.SenderEmailAddress
            strColD = olItem.Body
            strColE = olItem.To
            strColF = olItem.ReceivedTime
         
        'write them in the excel sheet
          xlSheet.Range("B" & rCount) = strColB
          xlSheet.Range("c" & rCount) = strColC
          xlSheet.Range("d" & rCount) = strColD
          xlSheet.Range("e" & rCount) = strColE
          xlSheet.Range("f" & rCount) = strColF
          
        'Next row
          rCount = rCount + 1
         
         Next
         
             xlWB.Close 1
             If bXStarted Then
                 xlApp.Quit
             End If
             
             Set olItem = Nothing
             Set obj = Nothing
             Set currentExplorer = Nothing
             Set xlApp = Nothing
             Set xlWB = Nothing
             Set xlSheet = Nothing
         End Sub
        
        • Hola pues ya lo probé, se parece mucho a lo que necesito, sólo que quiero adaptarlo para que el script se dispare cuando en el asunto tenga un texto en especifico, lo que hice para implemetarlo, lo modifiqué CopyToExcel(itm As Outlook.MailItem) pero el problema es que lo hace pero con el o los correos que estén seleccionados, yo quiero que lo haga con el correo que acaba de llegar y que cumple con la regla.
          De antemano agradezco tu ayuda, y como comentaste, estaré pendiente.
          Saludos.

    • Saludos, yo lo que quiero es que me descargue todos los archivos adjuntos que me envien a mi cuenta de correo, pero el detalle esta que no descarga nada, estoy utilizando outlook 2016, me podrian ayudar? lo unico que modifique del codigo fue la carpeta de descarga.

      Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
      Dim objAtt As Outlook.Attachment
      Dim saveFolder As String
      saveFolder = “D:Archivos Outlook”
      For Each objAtt In itm.Attachments
      objAtt.SaveAsFile saveFolder & “” & objAtt.DisplayName
      Set objAtt = Nothing
      Next
      End Sub

      ya esta debidamente creada D:Archivos Outlook en mi pc.

      Otra consulta, es posible que todo el correo electronico que entre, pasarlo a texto?, es que quiero extraer los correos electronicos que entran y estar agregandolos manualmente es un dolor de cabeza

      • Buen dia Cristian

        Los he utilizado hasta en Office 2013, desconozco si en Office 2016 cambiaron la forma de ejecutar o el tipo de sentencia; el Codigo esta correcto quizas es mas estricto y esta revisando a detalle y la diagonal de la ruta esta causando algun problema. ya que tambien la declare al momento de guardar.

        Hay algunos artículos para guardar a TXT el cuerpo de correo, puedes ver la en la búsqueda AQUI

        Saludos y disculpa la tardanza, no nos habíamos percatado de tu mensaje ya que se habia marcado como SPAM tu comentario.

        Saludos.

    • Excelente script yo utilize este: “VBScript que guarda todos los archivos recibidos (No remplaza existentes agrega la fecha al archivo y Nombre de la persona quien lo envió “From / De”).”

      Pero me gustaría saber si es posible:
      *que dependiento de la direccion del remitente se guarde en una carpeta en especifica.
      ejemplo:
      si recibo un correo de [email protected] se guarde en “C:FacturasPortalmastips”
      si recibo un correo de [email protected] se guarde en “C:Facturasejemplo2”

      su aplicacion sería: recibo diferentes facturas de proveedores a un mismo correo, entonces quiero que dependiendo de la dirección del remitente me guarde en la carpeta que yo ponga en la ruta para ese remitente.

      Mil Gracias

      • Buen dia Victor

        Si es posible realizar lo solicitado, debes crear varios modulos copias y pegas el mismo Script modificas la ruta a cada carpeta y el nombre del Script (Renglon 1) debes cambiar el nombre a cada uno por ejemplo Public Sub saveAttachtoDiskPortalMasTips(itm As Outlook.MailItem) no se pueden repetir los nombres.

        Después de esto debes crear una regla por cada contacto diferente y Listo.

        Si tienes alguna duda o comentario no dudes en escribirnos.

        Saludos.

        • Gracias por responder, se me habia ocurrido eso, pero es algo de talacha porque son como 100 proveedores, ¿hay forma de hacerlo con un For y un if?
          por ejemplo:

          Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
          Dim objAtt As Outlook.Attachment
          Dim saveFolder As String
          Dim saveFolder1 As String
          Dim dateFormat
          Dim getFrom
              dateFormat = Format(Now, "yyyy-mm-dd H-mm")
              getFrom = itm.SenderEmailAddress
          saveFolder = "C:Archivos"
          saveFolder1 = "C:ArchivosPortalMastips"
          
          For Each objAtt In itm.Attachments
               If ((InStr(itm.SenderEmailAddress, "@portalmastips") )) Then
                    objAtt.SaveAsFile saveFolder1 & "" & dateFormat & " - " & getFrom & " - " & objAtt.DisplayName
                    Set objAtt = Nothing
                    Set itm = Nothing
                    
              End If
          End Sub
          

          funcionará?

          Saludos

          • Buen dia Victor!

            Necesitas el nombre en algun formato?

            Te paso el siguiente este crea una carpeta con el nombre de cada remitente y lo guarda automáticamente los adjuntos en cada carpeta.

            Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
            Dim objAtt As Outlook.Attachment
            Dim saveFolder As String
            Dim dateFormat
            Dim getFrom
            Dim oFSO
            Set oFSO = CreateObject("Scripting.FileSystemObject")
            
                dateFormat = Format(Now, "yyyy-mm-dd H-mm")
                getFrom = itm.senderName
            saveFolder = "C:Archivos" & getFrom & ""
            
            If Not oFSO.FolderExists(saveFolder) Then
              oFSO.CreateFolder saveFolder
            End If
            
                 For Each objAtt In itm.Attachments
                      objAtt.SaveAsFile saveFolder & "" & dateFormat & " - " & objAtt.DisplayName
                      Set objAtt = Nothing
                      Set itm = Nothing
                 Next
            End Sub

            Saludos.

    • Primero muchas gracias por todo tu apoyo, una consulta siguiendo el siguiente codigo como le hago para que en vez de guardarlo con la fecha extraiga 2 palabras del asunto del correo.

      Public Sub saveAttachtoDisk (itm As Outlook.MailItem)
      Dim objAtt As Outlook.Attachment
      Dim saveFolder As String
      Dim dateFormat
          dateFormat = Format(Now, "yyyy-mm-dd H-mm")
      saveFolder = "C:XML"
      For Each objAtt In itm.Attachments        
                    if InStr(objAtt.DisplayName, ".xml") Then
                    objAtt.SaveAsFile saveFolder & "" & dateFormat & " - "& objAtt.DisplayName
                end if    
           Next
      End Sub
      
      • Buen dia Rene

        Se tiene que agregar una linea para tomar la parte del Asunto que deseas, no se puede tomar en especifico 2 palabras pero una parte de este si indicando donde comienza y cuantas letras o caracteres tomara hacia la derecha. La linea donde modificas esto es la 14 y donde se asigna el nombre es la 15, yo lo acomode de la siguiente manera Fecha – Asunto – Nombre archivo.

        Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String
        Dim dateFormat
        Dim getSubject As String
        dateFormat = Format(Now, "yyyy-mm-dd H-mm")
        saveFolder = "C:XML"
        ' get Subject
        getSubject = itm.Subject
        
            For Each objAtt In itm.Attachments
              If InStr(UCase(objAtt.DisplayName), ".XML") Then
                ReplaceIllegalChars getSubject, "-"
                finalSubject = Mid(getSubject, 4, 12)
                objAtt.SaveAsFile saveFolder & dateFormat & " – " & finalSubject & " – " & objAtt.DisplayName
               End If
            Next
        End Sub
        
        Private Sub ReplaceIllegalChars(getSubject As String, sChr As String)
          getSubject = Replace(getSubject, "/", sChr)
          getSubject = Replace(getSubject, "", sChr)
          getSubject = Replace(getSubject, ":", sChr)
          getSubject = Replace(getSubject, "?", sChr)
          getSubject = Replace(getSubject, Chr(34), sChr)
          getSubject = Replace(getSubject, "< ", sChr)
          getSubject = Replace(getSubject, ">", sChr)
          getSubject = Replace(getSubject, "|", sChr)
          getSubject = Replace(getSubject, "*", sChr)
        End Sub
        

        Saludos.

    • hola…y si quisiera que el archivo se guardara con el nombre del subject?

      especificamente requiero que se guarde con un numero de factura que viene en el subject, es posible?

      “CM shipment B00542322 to”

      el que quiero para nombre es el B00542322 y asi sucesivamente a como vayan llegando

      agradezco de antemano…me ha facilitado muchisimas cosas tu blog

      • Buen dia Sandra!

        Apoyamos a Rene (Comentario anterior) con algo similar adjunto el VBScript, La linea donde modificas cual es la parte que va a tomar es la 14 y donde se asigna el nombre es la 15, yo lo acomode de la siguiente manera Fecha – Asunto – Nombre archivo.

        Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String
        Dim dateFormat
        Dim getSubject As String
        dateFormat = Format(Now, "yyyy-mm-dd H-mm")
        saveFolder = "C:XML"
        ' get Subject
        getSubject = itm.Subject
        
            For Each objAtt In itm.Attachments
              If InStr(UCase(objAtt.DisplayName), ".XML") Then
                ReplaceIllegalChars getSubject, "-"
                finalSubject = Mid(getSubject, 12, 9)
                objAtt.SaveAsFile saveFolder & dateFormat & " – " & finalSubject & " – " & objAtt.DisplayName
               End If
            Next
        End Sub
        
        Private Sub ReplaceIllegalChars(getSubject As String, sChr As String)
          getSubject = Replace(getSubject, "/", sChr)
          getSubject = Replace(getSubject, "", sChr)
          getSubject = Replace(getSubject, ":", sChr)
          getSubject = Replace(getSubject, "?", sChr)
          getSubject = Replace(getSubject, Chr(34), sChr)
          getSubject = Replace(getSubject, "< ", sChr)
          getSubject = Replace(getSubject, ">", sChr)
          getSubject = Replace(getSubject, "|", sChr)
          getSubject = Replace(getSubject, "*", sChr)
        End Sub
        

        Nos confirmas si es lo que requieres
        Saludos.

    • Hola, antes que nada muchas gracias por esta página y sobretodo por tu excelente labor compartiendo tus conocimientos en favor de los demás y resolviendo los problemas que con nuestro poco o mucho conocimiento no logramos solucionar.
      En mi caso aún no pruebo ninguno de los VBScript del principio de esta página ya que en mis ratos libres del trabajo voy leyendo cada uno de los mensajes y sus soluciones, por cierto excelentes.
      Con esto de la facturación electrónica en México y la recepción de archivos XML y PDF por correo muchas personas no entienden la importancia de guardar, organizar y controlar está información, de hecho aún siguen pensando que guardar el papel es más importante que guardar los archivos electrónicos (situaciones personales realmente vividas) y no se están preocupando por guardarlo y peor aún por organizarlos para su fácil y rápida consulta en caso de una revisión por parte de la autoridad.
      Trabajo en una empresa que aún tienen la forma de pensar que describí arriba pero yo veo todo lo contrario ya que soy parte de la comunidad informática y por eso quiero adelantarme a lo que algún día sucederá y al único que culparán es al informático de la empresa (es decir yo).
      Bueno después de tanto preámbulo lo que quiero hacer es guardar y organizar todos los correo de las facturas electrónicas que se reciban de nuestros proveedores, para esto ya tengo una dirección de correo exclusiva para dicho fin en Outlook 2010.
      Necesito guardar en carpetas los archivos XML y PDF que vienen en el mensaje de correo pero que el nombre de las carpetas sea el valor que viene en el atributo “Emisor rfc” del archivo XML y en caso de que no exista la carpeta con ese nombre se cree una nueva carpeta y si ya existe pues solo que se guarden los archivos XML y PDF en ella.
      Desafortunadamente no todos siguen un formato especifico en sus correo de envío de facturas ni en sus nombre de archivos XML y PDF por eso mi necesidad de tratar de organizarlos y guardarlos.
      Espero me puedas ayudar y te agradezco tu ayuda por anticipado.

        • Hola que tal, gracias por tu respuesta y disculpa la demora en contestar.

          Solo viene en el campo mencionando, no viene en el nombre del archivo.

          Sigo al pendiente.
          Saludos.

          • Buen dia Jose!

            Lo que requieres es necesario leer la etiqueta del XML, es completamente diferente a los Scripts en el articulo.
            Es posible realizar esto, he visto algunas formas de leer las etiquetas de los XML con VBScript mas no lo he implementado yo en alguno, Suena interesante lo que solicitas asi que investigare un poco para implementarlo, te comentare el código cuando lo tenga; mas si me tardare algunas semanas ya que tengo primero otros proyectos y estoy bastante atareado en el trabajo (El que paga las cuentas).

            Estamos al contacto.

            Saludos.

      • Buen dia!

        Puedes realizar instrucciones desde PowerShell para manipular Outlook pero no puedes ejecutar PowerShell dentro del editor de Visual Basic de Outlook.

        Si quieres puedes ejecutar instrucciones desde Visual Basic pero entramos en lo mismo que lo mencionado utilizas VB para ejecutar un Script PowerShell..

        Ejemplo VB:

        LaunchPowerShell.VBS
        
        Set objShell = CreateObject(“Wscript.shell”)
        
        objShell.run(“powershell -noexit -file c:1-TestEjemplo.ps1”)
        
    • Hola Fernando. Cuando ví tu post se me abrió el cielo. No te puedes llegar ni a imaginar lo que se me ha ocurrido con tu información. Me gustaria saber si es posible generar tantos macros como expedientes pueda tener de manera que cuando recibiera el e-mail de un cliente el archivo adjunto se guarada en la carpeta asignada. Te agradecería que, por favor, pudieras responderme. Asimismo, el problema que tengo es que no me funciona el VSCRIP y he seguido y repasado paso por paso. Tengo OUTLOOK 2013 y el texto del Módulo 1 que he introducido es este:

      Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
      Dim objAtt As Outlook.Attachment
      Dim saveFolder As String
      Dim dateFormat
      Dim getFrom
          dateFormat = Format(Now, "yyyy-mm-dd H-mm")
          getFrom = itm.SenderName
      saveFolder = "C:UsersJUANMADocuments.- ADJUNTOS OUTLOOK"
           For Each objAtt In itm.Attachments
                objAtt.SaveAsFile saveFolder & "" & dateFormat & " - " & getFrom & " - " & objAtt.DisplayName
                Set objAtt = Nothing
                Set itm = Nothing
           Next
      End Sub
      

      POR FAVOR, ¿ME PUEDES AYUDAR DICIENDOME SI HAY ALGO INCORRECTO O POR QUE NO ME FUNCIONA? MUCHISIMAS GRACIAS Y ENHORABUENA. Como es la primera vez que escribo en un foro y no se cómo funciona te agradecería que pudieras enviarme también la respuesta por e-mail. Muchas gracias. Saludos cordiales.

      • Buen dia Juan Manuel

        Respecto a la respuesta, si le pusiste en suscribir al momento de comentar debe llegarte un correo cuando alguien responda sobre tu mensaje.

        A tu consulta: Si puedes generar cuantos Macros desees tomando en cuenta que dependiendo la cantidad (20, 30 o mas) pueda llegar a verse afectado el rendimiento (velocidad) de Outlook.
        Respecto al error: No funciona es, no ejecuta el Script o es como si no hiciera nada marca error? si es lo 2do puedes quitar la diagonal invertida “” que se encuentra al final de la ruta que se encuentra en saveFolder, estuve revisando los Scripts y algunos no deberían llevarlo.

        También si te sirve puedes encontrar el siguiente Script de ayuda.

        Este crea una carpeta con el nombre de cada remitente y lo guarda automáticamente los adjuntos en cada carpeta.

        Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String
        Dim dateFormat
        Dim getFrom
        Dim oFSO
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        
            dateFormat = Format(Now, "yyyy-mm-dd H-mm")
            getFrom = itm.senderName
        saveFolder = "C:Archivos" & getFrom & ""
        
        If Not oFSO.FolderExists(saveFolder) Then
          oFSO.CreateFolder saveFolder
        End If
        
             For Each objAtt In itm.Attachments
                  objAtt.SaveAsFile saveFolder & "" & dateFormat & " - " & objAtt.DisplayName
                  Set objAtt = Nothing
                  Set itm = Nothing
             Next
        End Sub
        
        • FERNANDO: ERES UN CAMPEON!! MUCHAS GRACIAS. YA FUNCIONA. Me permito trasladarte dos consultas vinculadas a este tema.

          1ª.- Sería posible la creación de un VSCRIPT que descargara el archivo que no va como adjunto sino que se encuentra en un link del e-mail.

          2º.- Sería posible la la creación de un VSCRIPT que creara un e-mail en el que se adjuntara un/s archivo previamente predeterminados.

          3º.- Es posible la creación de un VSCRIPT que descargue un archivo al que se accede mediante un link y que una vez descargado, de forma automática, genere un e-mail que adjunte dicho archivo y lo envíe a un grupo de personas.

          MUCHISIMAS GRACIAS POR TU AYUDA. RECIBE MUY CORDIALES SALUDOS!!!

          • Hola Fernando, puesto en funcionamiento y comprobado el resultado de la descarga de todos los datos adjuntos, modificación de nombre automática (fecha, remitente, asunto) he podido comprobar que hay una serie de archivos (PNG de hasta 20 kb incluídas, DAT y GIF) que suelen corresponder a logos o información irrelevante. En uno de tus artículos indicas la posibilidad de hacer una descarga automática en una carpeta de Windows pero sólo de ciertos archivos. A la vista de la inutilidad de los archivos (PNG de hasta 20 kb incluídas, DAT y GIF) podrías adicionar en el “VBScript que guarda todos los archivos recibidos (No remplaza existentes agrega la fecha al archivo y Nombre de la persona quien lo envió “From / De”)” la exclusión de los los archivos (PNG de hasta 20 kb incluídas, DAT y GIF). Creo que sería de muchísima utilidad para [email protected] de nosotros ya que la finalidad de tus VSCRIPS es facilitar nuestra labor y esos “archivitos” inútiles molestan muchísimo. Hay PNG de 21 kb o superiores que no los puedo ni debo excluir porque esos sí que suelen ser documentos (y no meros logos o imágenes irrelevantes).

            Como te decía, son nuevo en esto, no se si es una falta de respeto trasladar tal petición. Si fuera así te adelanto mis disculpas y con no contestar me doy por enterado. En todo caso, reitero mi sorpresa y enomre agradecimiento. Saludos muy cordiales a todos.

          • Buen dia Juan Manuel

            No te preocupes no es ninguna molestia, la cuestion de yo obtener pequeños proyectos es porque estoy comenzando en el mundo de los Macros y Scripts el cual me sirve como practica e investigación a nuevas soluciones el cual como comento en mi firma me gusta esto solo que doy respuesta a su debido tiempo ya que no descuido mis labores en el corporativo (El cual paga las cuentas de mi familia y las mias). por el momento te puedo comentar que puedes agregar el IF mencionado en otros Scripts añadiendo los tipos de archivos que quieres guardar.

                 For Each objAtt In itm.Attachments
                      if (InStr(UCase(objAtt.DisplayName), ".XML") Or InStr(UCase(objAtt.DisplayName), ".PDF")Or InStr(UCase(objAtt.DisplayName), ".DOC") Or InStr(UCase(objAtt.DisplayName), ".DOCX") Or InStr(UCase(objAtt.DisplayName), ".PNG")) Then
                      objAtt.SaveAsFile saveFolder & "" & dateFormat & " - " & getFrom & " - " & objAtt.DisplayName
                      Set objAtt = Nothing
                      Set itm = Nothing
            	  end if
            

            Suena Interesante lo que mencionas asi que lo pondre en las solicitudes, Tengo otras solicitudes por responder primero, por lo antes mencionado podría tardar algunas semanas aun en contestar la solicitud.

          • Buen dia Juan Manuel

            Gracias por los buenos comentarios, Ahora respondiendo a tus consultas.

            1.- Es posible descargar archivos de un hipervinculo.
            2.- Es posible con algunos trucos pero existen diferentes aplicaciones que se le pueden dar y eso representa adecuaciones distintas en codigo todo dependiendo el uso que se le vaya a dar, esto en respuesta cuando llegue un correo de X persona? o cierta fecha?
            3.- Es posible crear un correo y adjuntar archivos el cual deben estar en una carpeta definidos previamente mas esta opcion es crear el cuerpo de correo por medio de VBScript el cual no tendria formato por la misma dificultad para darle uno por medio de código.

            Saludos.

    • Fernando me refería a esto: VBScript que guarda todos los archivos recibidos (No remplaza existentes agrega la fecha al archivo y Nombre de la persona quien lo envió “From / De”). Gracias. Disculpa. Saludos.

    • Hola buen dia
      Yo se que tal ves sea algo simple, pero no lei ninguna pregunta/respuesta al respecto
      Mi caso es este. A mi me llegan correos con adjuntos que tienen el mismo nombre. Ya intente usar el script que les anexa la fecha, pero que necesito modificar para que en lugar de la fecha les de un numero consecutivo. Ya lei que es posible insertando un contador. . pero no se como hacerlo. Me podrian ayudar

      • Buen dia

        Debes agregar las siguientes lineas

        Dim Consecutivo As Integer

        En la siguiente linea debes agregar el consecutivo.
        objAtt.SaveAsFile saveFolder & “” & Consecutivo & ” – “ & objAtt.DisplayName
        Consecutivo = Consecutivo + 1

        Un ejemplo

        	  
        Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String
        Dim Consecutivo As Integer
        saveFolder = "C:Archivos"
             For Each objAtt In itm.Attachments
                  objAtt.SaveAsFile saveFolder & "" & Consecutivo & " - " & objAtt.DisplayName
                  Consecutivo = Consecutivo + 1
                  Set objAtt = Nothing
             Next
        End Sub
        
    • Hola Gracias por tu ayuda,
      me puedes ayudar con un script para que discrimine por el nombre del archivo y no por la extensión?. me llegan muchos archivos, todos con extensión pdf, pero me gustaría meter en una carpeta todos los que dicen “cotizacion” y no los que dicen factura (ejemplo).
      GRACIAS ERES DE GRAN AYUDA!

      • Buen dia Gabriel

        Solo debes cambiar el ‘.PDF’ por ‘COTIZACION’ y va a incluir todos los archivos que contengan la palabra COTIZACION, puedes utilizar 2 comparaciones por ejemplo

        if (InStr(UCase(objAtt.DisplayName, “COTIZACION”)) AND (InStr(UCase(objAtt.DisplayName, “.PDF”)))) Then

        para que te filtre que contengan la palabra COTIZACION y .PDF

        Saludos.

    • Buenos días,
      muy interesante, es lo que estoy necesitando. Lo que necesito, es que en vez de alojar el archivo en mi disco Local me lo aloje en un servidor haciendo http://FTP... estoy buscando como hacerlo pero se me dificulta.
      podrias ayudarme? Muchas gracias 😀 Excelente blog

      • Buen dia Cristian

        Debes guardarlos temporalmente en una carpeta local y después subirlos al FTP; puedes mantener sincronizado el folder con el cliente FTP de tu preferencia o de igual forma utilizar alguno de los codigos VBScript FTP como el que muestran en el siguiente blog de codescript

        Saludos.

    • Buen dia Wilmer

      Disculpa la tardanza, hemos presentado algunos problemas con el sitio el cual dimos prioridad.

      Esto puede dar si se omitió algo al instalar Visual Basic for Applications, también otro detalle solo muestra “Run a Script” para los correos recibidos, esta opción no se encuentra para los enviados.

      Nos confirmas cualquier detalle.

      Saludos

  2. Buenas Tardes

    Me ha servido de mucho tu código pero presente un dilema quisiera saber si hay manera de que el archivo se renombre con el remitente y la fecha exceptuando el nombre original del archivo recibido esto debido a que estoy creando un informe con estos archivos pero la persona que me envía la información los nombra por decirlo “coberturas diarias productos x + productos y 36 sabado” y a mi se me haría mas fácil algo como “coberturas cierre de semana 36” solo quiero saber si se puede renombrar dicho archivo desde el código al momento de guardarlo para no batallar y de no ser así buscar otra opción de antemano agradezco la atención brindada

    • Buen dia Ricardo!

      Solo debes eliminar objAtt.DisplayName que es el nombre del archivo cualquiera de los ejemplos que proporcionamos, por ejemplo el siguiente da el nombre al archivo Fecha-Remitente-NombreArchivo el cual si eliminas lo antes mencionado le dara el nombre Fecha-Remitente.

      Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
      Dim objAtt As Outlook.Attachment
      Dim saveFolder As String
      Dim dateFormat
      Dim getFrom
      dateFormat = Format(Now, “yyyy-mm-dd H-mm”)
      getFrom = itm.senderName
      saveFolder = “C:\Archivos\”
      For Each objAtt In itm.Attachments
      objAtt.SaveAsFile saveFolder & “\” & dateFormat & ” – ” & getFrom & ” – ” & objAtt.DisplayName
      Set objAtt = Nothing
      Set itm = Nothing
      Next
      End Sub

      Saludos.

      • Muchas gracias aun sigue sin funcionar me el código creo es por la regla voy a intentar cambiar la regla que estoy estableciendo aparte de que la persona que me envía la información salio de vacaciones en serio te agradezco la atención brindada

        • Buen dia Ricardo

          Lamentamos escuchar que no funcione la regla que generas para ejecutar el Script, si encuentras que es lo que estaba impidiendo que te funcione correctamente favor de retroalimentarnos para tener registro de otros problemas por el cual no se ejecutan.

          Estamos en contacto, Saludos.

  3. Buenas tardes Fernando, gracias por el ayuda que nos brindas en esta pagina, me a funcionado mucho para archivar los correos y los adjuntos que recibo en volumen, pero tengo ahora una solicitud, una vez importado el adjunto de excel, creer una macro para que estos pasen a otro excel nuevo, pero necesito vincular los datos de la primera columna del nuevo excel con el correo descargado en la carpeta, esto es posible, mil gracias de nuevo y quedo atento.

      • Buen día Fernando, que pena contigo creo que no fue claro, te explico en detalle; recibo email de varios clientes con un archivo adjunto de excel (este archivo de excel es igual para todos los cliente) La columna A contiene un # de Transporte (501,502,503) y la columna B un nombre de servicio (Servicio_A o Servicio_B), en primera instancia la idea es ejecutar un script que me permita consolidar en un solo excel la información de todos los adjuntos de excel que recibo de los clientes, para ello utilice tu script para exportar los correo y los adjuntos en una carpeta por aparte, y posteriormente estaba ejecutando una macro para copiar y pegar la información de los excel exportados en uno solo, “pero es ahí donde deseo vincular ese numero de transporte de la columna A con el email que el cliente esta enviando”. Aveces los # de transporte se me repiten pero el nombre del servicio cambia, por eso estaba exportando los archivos de excel con la fecha y hora para que esto me sirviera de consecutivo. La idea en general es consolidar la información de los excel recibidos vía email en uno solo y que desde la columna A pueda dar clic al # de transporte y ir a ver el email remitido por el cliente. Gracias de antemano por tu colaboración y por la orientación que me puedas brindar.

        • Buen dia Alexander,

          Entiendo ya lo que quieres hacer, es llevar un registro en un Excel de los correos que al darle clic te abra el correo que guardaste local, por ejemplo la información seria algo como VBScript – Exportar Información de correos Outlook a Excel la cuestión es ligar el correo que guardaste en el excel, por el momento no se me ocurre como hacer esto con por medio de un script en visual basic, se requeriria generar un registro con el nombre de todos los email que guardas en disco y de ahí que genere el enlace, mas no se si funcione correctamente en base el entorno que manejas.

      • si gracias estoy utilizando por ahora el primero y en disco c: tengo la carpeta llamada archivos y ya configure la reglas en el outlook pero no me descarga los archivos adjuntos.

        Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
        Dim objAtt As Outlook.Attachment
        Dim saveFolder As String
        saveFolder = “C:\Archivos\”
        For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & “\” & objAtt.DisplayName
        Set objAtt = Nothing
        Next
        End Sub

          • te cuento que si me funciono a perfeccion pero en otro equipo , en el equipo que estoy tratando de definir estos script(en el que necesito) no me funciona.. estoy mirando que podria ser..

          • Buen dia Andrea

            Puedes colocar el siguiente código después de la linea 6 (del For Each)

            MsgBox (“Archivo: ” & saveFolder & “\” & objAtt.DisplayName)

            y nos comentas lo que te muestre en el mensaje.

  4. Bueno días,
    Me pasa lo mismo que a Andrea , estoy usando el primero y guardando en C:\Archivos , y no me guarda ningún archivo , le he quitado la barra diagonal final, he configurado la seguridad de las macros para que los ejecute y tampoco, mi Office es el 2013.

    saludos

  5. Hola, lo pongo asi?:

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    dateFormat = Format(Now, “yyyy-mm-dd H-mm”)
    saveFolder = “C:\Archivos”
    MSGBOX (“ARCHIVO: ” & SAVEFOLDER & “\” & OBJATT.DISPLAYNAME)
    For Each objAtt In itm.Attachments
    objAtt.SaveAsFile saveFolder & “\” & dateFormat & ” – ” & objAtt.DisplayName
    Set objAtt = Nothing
    Next
    End Sub

          • Hola, he modificado esas comillas y ya me deja guardarlo, pero no hace absolutamente nada, copio el código para que veáis como queda en el editor:

            1
            2
            3
            4
            5
            6
            7
            8
            9
            10
            11
            Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
            Dim objAtt As Outlook.Attachment
            Dim saveFolder As String
            Dim dateFormat
            dateFormat = Format(Now, “yyyy-mm-dd H-mm”)
            saveFolder = “C:\Archivos”
            For Each objAtt In itm.Attachments
            MsgBox (“ARCHIVO: ” & saveFolder & “\” & objAtt.DisplayName)
            objAtt.SaveAsFile saveFolder & “\” & dateFormat & ” – ” & objAtt.DisplayName
            Set objAtt = Nothing
            Next
            End Sub

          • Buen dia Jorge

            Te debe mostrar un cuadro de dialogo (mensaje) con la ruta y el nombre de cada archivo adjunto en un cuadro de dialogo, si no es asi por alguna razón no se esta ejecutando correctamente puede ser por la regla o por configuración de seguridad de tu equipo.
            Que tipo de archivo adjunto contiene tu correo?, si crees que todo esta correcto y continua sin ejecutarse intenta remplazando tu codigo por el siguiente:

            Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
            MsgBox ("Ejecutado correctamente")
            End Sub

            Este te debe mostrar cada que la regla se cumpla un mensaje Ejecutado correctamente.

            Nos comentas.

          • solucionado….
            Te cuento el problema era que cada vez que yo copiaba el código directamente de esta pagina y pegarlo en el editor del Outlook, se me agregaban los números de lineas al principio y luego el código, yo creía que eso era normal, pero no funcionaba he probado a eliminar esos numeros de linea y ya ha funcionado perfectamente, voy hacer mas pruebas con los otros códigos que están puestos en la pagina y si tengo problemas ya os comento.

            Muchas gracias por todo, saludos

  6. Buenos días.

    Y si los adjuntos que yo me quiero bajar no están en la Bandeja de Entrada sino que los tengo almacenados en diferentes .pst ya almacenados en local ¿como lo hago para que me descargue todos los adjuntos de correos ya clasificados y archivados en pst?

    Muchas gracias.

  7. Hola Fernando: Estoy buscando lo siguiente: Tengo acceso a un buzón donde llegan facturas PDF y XML de nuestro proveedor de servicio. Necesido descargar esos adjuntos pero sin tener que abrir los archivos. Tengo la versión 2013 ¿se puede?

  8. Hola, como puedo hacer para que el script NO tome las imagenes ANEXAS al cuerpo del mensaje de correo (por ejemplo las utilizadas en las firmas y otras) y solo tome las imagenes que estan efectivamente enviadas como ADJUNTOS

    • Buen dia Javier

      Actualice el articulo con un script (El tercero) que excluye los archivos de un peso menor a 5 Kb.

      Básicamente solo de agrego una condición que debe cumplir el archivo, este la puedes agregar a cualquier otro script del articulo.

      If objAtt.Size > 5000 Then ‘
      ‘Codigo a ejecutar si se cumple la condición.
      End If

      Saludos,

  9. Excelente. Gracias por la actualizacion “custom”. Y por la rapida respuesta. Realmente es una excelente fuente tu blog, gracias por tenerlo y mantenerlo. Peruebo la adicion y en caso de cualquier cosa la comento, pero parece bastante sencillo.

  10. Hola de nuevo. Ya probe la sugerencia para evitar guardar imagenes que sean MENORES a cierto tamaño y funciona perfectamente (OutLook 2013). La observacon aqui es si habrá otro criterio para seleccionar solo las imagenes anexas (adjuntas) y NO las embebidas en el cuerpo del documento. El problema es que algunas imagenes que se embeben en el cuerpo del mensaje de coorreo, pueden sobrepasar el limite impuesto y guardarse indebidamente, mientras que otras, genuinas y validas, pudieran ser eliminadas. Un ejemplo: el mensaje contiene la firma del remitente en una imagen con su logo y esta pesa 50 kB. Incluye como adjunto la imagen AUTO.jpg y esta pesa 35 kB. En este caso si nosotro slimitamos a que sean guardadas solo las imagenes MAYORES a 40 kB, se guardaria la FIRMA pero NO la imagen AUTO.jpg, o sea totalmente opuesto a lo deseado. Este es un caso real d elos tamaños de firma e imagen.
    Habra otro metodo para discriminar entre iamgenes EMBEBIDAS y ADJUNTAS?
    No se si Outlook hace alguna diferenciacion en alguna caracteristica de una imagen embebida y una adjunta???

    Por cierto, me tome la libertad e hice algunas combinaciones con tu codigo y resulto este que les comparto, que lo que hace es:
    – checar que solo se guarden imagenes arriba del tamaño deseado
    – guardar solo los tipos de imagen deseado
    – guardar los anexos en una ruta especifica
    – darles el nombre: asunto _ nombre del anexo removiendo todos los caracteres ilegales que podrian impedir el guardado.

    Public Sub Anexos(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim getSubject As String
    
    saveFolder = "C:\Users\Imagenes"
    getSubject = itm.Subject
      For Each objAtt In itm.Attachments
        If objAtt.Size > 36000 Then
        'este loop es para que se discriminen todas las imagenes abajo del tamaño indicado en Bytes  (36000 por ejemplo) y NO se guarden
           If ((InStr(objAtt.DisplayName, ".tif") Or InStr(objAtt.DisplayName, ".tiff") Or InStr(objAtt.DisplayName, ".pdf") Or InStr(objAtt.DisplayName, ".bmp") Or InStr(objAtt.DisplayName, ".jpg") Or InStr(objAtt.DisplayName, ".jpeg"))) Then
                  ReplaceIllegalChars getSubject, " "
                  objAtt.SaveAsFile saveFolder & "\" & getSubject & " _ " & objAtt.DisplayName
           End If
        End If
      Next
    End Sub
    
    Private Sub ReplaceIllegalChars(getSubject As String, sChr As String)
      getSubject = Replace(getSubject, "/", sChr)
      getSubject = Replace(getSubject, "\", sChr)
      getSubject = Replace(getSubject, ":", sChr)
      getSubject = Replace(getSubject, "?", sChr)
      getSubject = Replace(getSubject, Chr(34), sChr)
      getSubject = Replace(getSubject, "", sChr)
      getSubject = Replace(getSubject, "|", sChr)
      getSubject = Replace(getSubject, "*", sChr)
    End Sub
    
    • Buen dia Javier

      Lamentablemente no tengo conocimiento de otro método, se me ocurre igual es una opción que posiblemente no te sirva ya que recibes imágenes en el cuerpo de correo también; cambiar la forma de lectura de los correos a Texto Plano (no es algo que haya probado que funcione).
      Vas a File>Options, Trust Center> clic en Trust Center Settings > Email security ahi cambiaras la forma de lectura de todos los correos (con esta opción se perderá el formato de los correos y si contienen imagenes embebidas tambien solo quedaran los adjuntos).

      Saludos.

  11. mmm puede ser una buena opcion ya que las imagenes recibidas como adjuntos son lo que realmente importa y no las embebidas ni el formato. Se puede instruir a los que envian las imagenes a que solo las manden como ADJUNTOS o si no, no serían procesadas. Gracias por la ayuda, Fernando. Buen dia.

  12. Lo felicito es un buen aporte, en mi caso llegan correos de varias personas y cada una con un adjunto, luego de procesar la solicitud debo reenviar ese adjunto a un grupo de personas incluyendo a la persona que lo envio y ademas del adjunto debo poner cierta informacion como es nombre, numero de solicitud y codigo. Es tedioso porque asi debo hacerlo con cada correo que llega hay alguna forma que eso se haga de forma automatica¿¿?? que la macro de FW al correo con el adjunto, a las personas determinadas y la informacion en el cuerpo del correo¿¿??

    • Buen dia Angela!

      Tengo unas consultas:

      1.- El grupo de personas es fijo?
      2.- El Nombre, Numero de solicitud y Código de donde lo obtienes?

      De ahi en fuera si se puede hacer forward modificando el cuerpo del correo, pero todo depende de donde obtengas la información.

      Quedamos en espera

  13. Fernando si uso Outlook en el movil, ya cuando estoy en la laptop me deja de funcionar el script y me aparece un msj en el cual me indica que: se ejecutara cuando compruebe mi correo y que ya no funcionara hasta comprobarlo en linea o desde otro dispositivo de correo

    • Buen dia Victor

      Yo tengo configuradas varias reglas en mi Outlook de la PC de escritorio (el cual siempre esta prendida para que estas reglas funcionen) y también lo tengo configurado en mi Teléfono, no me ha mostrado error.

      El error que comentas de comprobar correo me suena a daño de mailbox o algun PST. ¿Te has percatado que marque error el Script y ocasione el cierre de Outlook?

  14. Que tal, solo para agradecer este articulo me ha salvado de horas y horas de trabajo, y aprovecharia para saber si me puedes apoyar en un caso pero en excel, necesito automatizar unos procesos, te cuento de manera breve, imagina una tabla en una columna tengo destinos con puntos intermedios ej: ciudad1-ciudad2-ciudad3, en las 3 columnas siguientes tengo como encabezado destino1, destino2, destino3, , y en la siguiente columna necesito saber el kilometraje total de la ruta es decir si de ciudad1 a ciudad 3 son 500 km, me ponga esos 500 km ahi , pero , si solo llego al destino de ciudad2(destino2), solo me ponga el equivalente del total de la ruta, cabe decir que en las columna de destinos solo puedo poner numeros “1”, si tengo 3, unos”1″, es el total de la ruta si en destino1 y destino 2 es donde solo tengo el “1”, es donde haga la equivalencia, saludos y excelente trabajo

    • Buen dia Obed

      Para lo deseado puedes utilizar formulas, lo mas facil seria crear una tabla con los valores y utilizar un vlockup ejemplo: =VLOOKUP(SUM(B3:F3),$M$2:$N$6,2,FALSE)

      Te envio por correo electrónico como utilice este en un ejemplo.

      Saludos.

  15. Hola que tal he intentado configurar esta regla con el script pero al momento de crearla no aparece en las opciones Ejecutar un script. tengo office 2016

  16. Tengo el mismo problema que el comentario de arriba. He de mencionar que la opción de habilitar todas las macros se encuentra activada, pero al momento de crear la regla, en el segundo paso no aparece la opción de “ejecutar un script”. ¿A qué se deberá, podrías sugerirme alguna solución por favor? Gracias anticipadas. Saludos!

  17. Hola como estas! agradezco me puedas ayudar con lo siguiente: Realice todos los pasos pero al momento de descargar los archivos se ejecuta el script pero cuando voy a la carpeta no hay nada, necesito crearlo porque recibo casi 400 Facturas por día de diferentes proveedores y las bajo siempre una a una, pierdo muchísimo tiempo, intente buscar en todos los comentarios hay usuarios a los que le paso lo mismo y lograron solucionarlo, yo probé todo lo que indicas y no logro solucionarlo, como puedo hacer para que me baje únicamente los archivos adjuntos de los mails que llegan y se marquen como leídos, necesito que cree una carpeta única, si recibo mail hoy entonces que cree una carpeta con fecha 04/2 si los recibo mañana otra carpeta con fecha 05/02 y así sucesivamente.
    Espero puedas ayudarme.

    muchas gracias.

    • Buen dia Ludmila R.

      Me puedes indicar cual es el código que estas implementando, de ser posible pega el código asi lo tienes.

      También lo que deseas lo puedes encontrar en VBScript – Guarda los archivos adjuntos dentro de la carpeta del Remitente catalogado con fecha

      solo de la linea 11 elimina lo siguiente getFrom & “\” & debe quedar asi: saveFolder = “C:\Archivos\” & dateFormat & “\”

      y las lineas 18 a 22 las sustituyes por

           For Each objAtt In itm.Attachments
      	if ((InStr(UCase(objAtt.DisplayName), ".XML") Or InStr(UCase(objAtt.DisplayName), ".PDF"))) Then
                objAtt.SaveAsFile saveFolder & objAtt.DisplayName
                Set objAtt = Nothing
                Set itm = Nothing
      	end if 
           Next	
      

      Nos comentas los resultados, no olvides seguirnos para que no te pierdas nuevas actualizaciones de nuestra pagina.
      Saludos.

  18. Buenisimo, combine algunos codigos para que me guarde en la carpeta de quien envía, junto con el titulo del mensaje y el nombre del archivo.
    Solo como nota, en el codigo para crear carpetas por quien envía, considerar utilizar tambien la línea…
    ReplaceIllegalChars getFrom, “-“

  19. Gracias por el Post. He realizado toda la configuración. La primera vez me ha funcionado, pero a partir ha dejado de funcionar. He vuelto a realizar todos los pasos e incluso he visto que la configuración de las macros esté habilitada, pero nada.
    Al ejecutarla de regla de forma manual, parece que hiciese algo pero no copia los ficheros ¿alguna idea de lo que pueda estar pasando?

    • Buen dia Petty

      Nos puedes comentar que código estas utilizando, de igual forma si puedes agregar MsgBox (“VBScript ejecutado”) después de la linea objAtt.SaveAsFile saveFolder & “\” & objAtt.DisplayName; y nos comentas si te muestra el dialogo VBScript ejecutado.

      Quedamos en espera del código que estas utilizando.

      Saludos.

  20. Buen dia, muchas gracias por la ayuda, tengo un problema, con el codigo que copia parte del asunto, al parecer se ejecuta, muestra la ventana donde se supone esta copiando los archivos, hice la solucion anterior, de agregar esta linea “MsgBox (“VBScript ejecutado”)”, no aparece ningun mensaje, pero estoy casis eguro q la macro si se ejecuta, de hecho utilizo macros en excel, pero ahora no se que pasa, copie y pegue la direccion de la carpeta en el codigo donde corresponde pero no aparecen los adjuntos descargados, agradeceria mucho su ayuda, gracias.
    Atentos saludos.

    • Buen dia Miguel!

      Si no muestra el mensaje y si se esta ejecutando quiere decir que no se cumple la condición que se esta declarando en el código, el código que comenta es el que tiene titulo “VBScript que guarda todos los archivos recibidos (No remplaza existentes agrega la fecha al archivo, Parte del Asunto (Subject))”?.

      Por medio del formulario de soporte nos puede enviar un archivo del cual quiere guardar (No importa si elimina el contenido del archivo, lo importante es el nombre y la extensión tal como llega) así como pegar el código que usted pego en Outlook.

      Saludos.

  21. Buenos dias, ayuda con el script que guarda con parte del asunto, lo ejecuto y trabaja, pero no se guarda nada en la carpeta de destino, ayuda. !!

  22. Estimado Fernando:
    Agradecerte de antemano el gran trabajo realizado y compartido.

    Tengo una duda sobre el Vscript que guarda y reemplaza el nombre del archivo (el primer caso que expones). Lo he copiado y cuando lo ejecuto con la regla prevista, me guarda el archivo recibido con un nombre nuevo “Data Sheet” y no me reemplaza el original. Le he dado vueltas al asunto pero no consigo ver el problema.

    Espero puedas ayudarme.

    Agradecido de antemano.
    David

    • Buen dia David

      Estoy revisando que puede estar ocasionando lo mencionado; mas no logro replicarlo, Nos puedes pegar el código tal cual lo pegaste en el editor, así como los archivos que te guarda con ese nombre son Excel? o cualquier formato le pone ese nombre?

      Quedamos en espera

  23. buenos dias,

    como podria separarlo si el mismo remitente con el mismo asunto me manda dos correos con el mismo adjunto (por dentro es diferente) es decir el correo es exactamente igual a la misma hora y mismo asunto y nombre del adjunto pero quiero que me guarde ambos como independientes sin reemplazarlos. ¿como podria hacerlo?

    • Buen dia Roberto

      Seria poner un contador a los archivos o agregarle los segundos a los archivos, te llegaran en el mismo segundo los correos?

      Si te vas por agregar segundos en la linea dateFormat agregas -ss en el formato

      dateFormat = Format(Now, “yyyy-mm-dd H-mm-ss”)

      Saludos.

      • buenos dias, gracias por tu rapida respuesta, en principio no tengo claro de si llegarian en el mismo momento, me gustaria que en ese caso no los sobrescribiera, me valdria con un (2) total esos archivos despues los coge otra macro y el nombre me es indiferente pero estaria bien tener en cuenta que puedan llegar en el mismo segundo, ¿como seria? de verdad muchas gracias.

        • Buen dia Roberto

          Prueba el siguiente código, en base a este puedes adaptar el que estes utilizando ya que utilizo las mismas variables, agregue al final de las lineas nuevas un comentario ‘No duplicar

          Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
          Dim objAtt As Outlook.Attachment
          Dim saveFolder As String
          Dim strFileName As String 'No duplicar
          Dim strNewName As String 'No duplicar
          Dim fso 'No Duplicar
          Dim intExtlen As Integer 'No Duplicar
          Dim strPre As String 'No Duplicar
          Dim strExt As String 'No Duplicar
          Set fso = CreateObject("Scripting.FileSystemObject") 'No Duplicar
          saveFolder = "C:\1-Tests\"
               For Each objAtt In itm.Attachments
                  strFileName = objAtt.DisplayName 'No Duplicar
                  If fso.fileexists(saveFolder & "\" & strFileName) = True Then 'No Duplicar
                      strNewName = strFileName 'No Duplicar
                      intExtlen = Len(strFileName) - InStrRev(strFileName, ".") + 1 'No duplicar
                      If InStrRev(strFileName, ".") > 0 Then 'No duplicar
                              strExt = Right(strFileName, intExtlen) 'No duplicar
                              strPre = Left(strFileName, Len(strFileName) - intExtlen) 'No duplicar
                          Else 'No duplicar
                              strExt = "" 'No duplicar
                              strPre = strFileName 'No duplicar
                          End If 'No duplicar
                      While fso.fileexists(saveFolder & "\" & strNewName) = True 'No duplicar
                              w = w + 1 'No duplicar
                              strNewName = strPre & Chr(40) & w & Chr(41) & strExt 'No duplicar
                          Wend 'No duplicar
                           'set the new filename
                          strFileName = strNewName 'No duplicar
                          w = 0 'No duplicar
                      End If 'No duplicar
                          
                    objAtt.SaveAsFile saveFolder & "\" & strFileName
                    AttachmentCount = AttachmentCount + 1
                    Set objAtt = Nothing
               Next
          End Sub
          

          Saludos.

  24. José Alberto Medina30 julio, 2016 at 12:31 pm
    Hola, antes que nada muchas gracias por esta página y sobretodo por tu excelente labor compartiendo tus conocimientos en favor de los demás y resolviendo los problemas que con nuestro poco o mucho conocimiento no logramos solucionar.
    En mi caso aún no pruebo ninguno de los VBScript del principio de esta página ya que en mis ratos libres del trabajo voy leyendo cada uno de los mensajes y sus soluciones, por cierto excelentes.
    Con esto de la facturación electrónica en México y la recepción de archivos XML y PDF por correo muchas personas no entienden la importancia de guardar, organizar y controlar está información, de hecho aún siguen pensando que guardar el papel es más importante que guardar los archivos electrónicos (situaciones personales realmente vividas) y no se están preocupando por guardarlo y peor aún por organizarlos para su fácil y rápida consulta en caso de una revisión por parte de la autoridad.
    Trabajo en una empresa que aún tienen la forma de pensar que describí arriba pero yo veo todo lo contrario ya que soy parte de la comunidad informática y por eso quiero adelantarme a lo que algún día sucederá y al único que culparán es al informático de la empresa (es decir yo).
    Bueno después de tanto preámbulo lo que quiero hacer es guardar y organizar todos los correo de las facturas electrónicas que se reciban de nuestros proveedores, para esto ya tengo una dirección de correo exclusiva para dicho fin en Outlook 2010.
    Necesito guardar en carpetas los archivos XML y PDF que vienen en el mensaje de correo pero que el nombre de las carpetas sea el valor que viene en el atributo “Emisor rfc” del archivo XML y en caso de que no exista la carpeta con ese nombre se cree una nueva carpeta y si ya existe pues solo que se guarden los archivos XML y PDF en ella.
    Desafortunadamente no todos siguen un formato especifico en sus correo de envío de facturas ni en sus nombre de archivos XML y PDF por eso mi necesidad de tratar de organizarlos y guardarlos.
    Espero me puedas ayudar y te agradezco tu ayuda por anticipado.

    • Buen dia Wilberth

      Como comentas si es de extrema importancia que estos archivos digitales se almacenen y resguarden en un lugar seguro.
      Anteriormente alguien ya me habían consultado de que forma se puede realizar lo que comentas, que seria lo optimo para esto; La cuestión mi conocimiento en Visual Basic es básico tengo noción de como realizarlo porque el lenguaje que mejor manejo es C# que es un % parecido; mas no he tenido oportunidad de revisar como realizarlo el coorporativo donde laboro me absorbe la mayor parte de mi tiempo lamentablemente 🙁

      No prometo proporcionarte la solución pronto pero lo tendré en mi lista de tareas :)..

      Que tengas un excelente día Wilberth

  25. Buen dia Fernando

    Muchas Felicidades por el post ciertamente me ha ayudado mucho tu script, lamentablemente la macro me ha dejado de funcionar. Actualmente estoy utilizando Office 365 ProPlus, al querer revisar paso por paso “F8” no realiza accion alguna.. cuando quito esta parte (itm As Outlook.MailItem) corre pero evidentemente al llegar a itm.SenderName me marca error. podrias ayudarme de favor para detectar el problema que tengo…

    Estoy utilizando tu script original

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dateFormat
    Dim getFrom
    Dim oFSO
    Set oFSO = CreateObject(“Scripting.FileSystemObject”)

    dateFormat = Format(Now, “yyyy-mm-dd H-mm”)
    getFrom = itm.SenderName
    saveFolder = “C:\Archivos\” & getFrom & “\”

    If Not oFSO.FolderExists(saveFolder) Then
    oFSO.Createfolder saveFolder
    End If

    For Each objAtt In itm.Attachments
    objAtt.SaveAsFile saveFolder & “\” & dateFormat & ” – ” & objAtt.DisplayName
    Set objAtt = Nothing
    Set itm = Nothing
    Next
    End Sub

    Muchas Gracias de antemano

    • Buen dia Miguel

      Lo único que debemos asegurarnos que tengas habilitados son los Macros, no he trabajado con Office 365 así que lamentablemente no puedo intentar replicar tu error.

      Crees que me puedas permitir conexión mediante teamviewer para ver el detalle y verificar si cambian librerías o se maneja igual a Office 2016.

      Me confirmas.

      Saludos.

  26. Hola Fernando,

    Muchas gracias por este gran aporte. Quisiera solicitarte una ayuda extra. Estoy usando tu script en Outlook 2013 para guardar archivos XML sin reemplazar archivos, el punto es que necesito separar los archivos XML entre los que llegan desde Proveedores (Facturas de Compra) y desde Clientes (Acuses de Recibo) para factura electrónica. Todos llegan al mismo correo electrónico.

    Los asuntos de los mails recibidos no son uniformes, por lo que la única opción que tendría para separar los XML por carpeta o a través de 3 scripts para distintos destinos, sería si se pudiese crear un script para Outlook que pudiese leer dentro del archivo adjunto XML algún campo o atributo.

    Para proveedores, el XML contiene el campo RutReceptor con el dato del Rut de mi empresa, la línea dice: 55555555-5

    Para clientes, el XML contiene el campo RutRecibe con el dato del Rut de mi empresa, la línea del XML dice: 55555555-5

    Si el script lograse leer el XML y utilizar esos criterios para definir una ruta para guardar el archivo sería espectacular.

    Estuve leyendo este sitio http://analystcave.com/vba-xml-working-xml-files/ en el cual hacen manejo de XML con VB y se acerca un poco a lo que necesito, pero no se aplicarlo al Script de Outlook para leer el adjunto.

    Otra opción sería que una vez descargado se usara otro script para buscar los criterios de Proveedor o Cliente y separase en una carpeta, pero tampoco lo se hacer.

    De antemano muchas gracias.

    • Buen dia Nicolas

      Tengo pendiente publicar un Script que lea atributos de los XML, he recibido varias solicitudes similares; mas por cuestiones laborales no he tenido tiempo de implementar la lectura de atributos en los scripts.

      Puedes seguirnos para que estés enterado cuando se realice la publicación de dicho script.

      Saludos.

  27. Hola, muchas gracias por tu excelente artículo. Estoy usando el script para guardar XML con Outlook 2013 y ningún problema, graba todo lo que recibo. Mi pregunta es:

    Es posible que en el script se pueda leer dentro de los campos contenidos en el archivo XML y si contiene un campo “A” con un dato “111111-1”, envíe el archivo a la carpeta “FolderA” y si contiene un campo “B” con un dato “111111-1” lo envíe a la carpeta “FolderB”?

    Estuve viendo esta página (http://analystcave.com/vba-xml-working-xml-files/) y al parecer se podría hacer, pero no se como usarlo.

    Gracias

  28. Buenos días,

    Tengo el siguiente codigo para ejecutar:
    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim paco As String
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    ‘saveFolder = “D:\Usuarios\iecgp\Downloads\Adjuntos_Allot\”
    For Each objAtt In itm.Attachments

    paco = Left(objAtt.DisplayName, 12)
    paco = Right(paco, 8)
    If paco = “INTRANET” Then
    saveFolder = “C:\prueba\”
    objAtt.SaveAsFile saveFolder & “\” & objAtt.DisplayName
    Set objAtt = Nothing
    ElseIf paco = “INTERNET” Then
    saveFolder = “D:\Informes_Allot\INTERNET\”
    objAtt.SaveAsFile saveFolder & “\” & objAtt.DisplayName
    Set objAtt = Nothing
    Else
    saveFolder = “D:\Informes_Allot\”
    objAtt.SaveAsFile saveFolder & “\” & objAtt.DisplayName
    Set objAtt = Nothing
    End If
    Next
    End Sub

    tengo el outlook 2013, me ha estado funcionando estos dias atras, pero hoy asi sin mas lo ejecuto con una regla a diario manualmente y hoy me ha dejado de funcionar, ejecuto la regla y la barra de ejecución se ejecuta pero no me descarga los ficheros en las carpetas correspondientes… Tengo windows 7 de 32 bits, no se que ha podido pasar…
    Alguien me puede ayudar?

      • Buenas, efectivamente me asegure de que fijándome en ambas paginas tuviera habilitado todo lo que pone… es muy raro que me dejara de funcionar sin mas… no se cual puede ser el motivo o donde encontrar la solución para que me vuelva a funcionar.

      • Buenas, antes de escribir me había fijado de otros comentarios para solucionar ese tema, pero no se porque razón sigue sin funcionar. Es raro porque de un día para otro ha dejado de funcionar sin mas… Se os ocurre algún otro motivo o como hacer si puedo borrar algunos ajustes y volver a iniciarlo para ver si funciona??
        Gracias

        • Buen dia Arzuq03

          Vamos a verificar primero que la regla este ejecutándose elimina todo y escribe MsgBox (“Hola”)

          Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
          MsgBox ("Hola")
          End Sub

          Cuando la regla ejecute el script te debe aparecer un cuadro de dialogo que diga Hola.

          Me confirmas si te lo muestra, esto indicaría que si se esta ejecutando correctamente y puede ser algo en el codigo.

  29. Hola muy util todo este aporte, 2 consultas amigo:

    1. Qué deberia hacer para pasar estos scripts a un modo de ejecucion, es decir ejecutar la macros manualmente, es decir que empiece como Sub y no como Public Sub
    2. Como hago para agregar la fecha de recepción del correo ya que con el dateFormat solo puedo poner la fecha con la que descargué los archivos.
    Gracias!!!

      • Muchísimas gracias, me sirvió totalmente.

        Una ultima consulta, como puedo hacer para que el nombre con el que guarde el archivo sea “nombre del archivo + fecha”, lo que pasa es que al cambiar el orden en la siguiente linea de código:

        objAtt.SaveAsFile saveFolder & “\” & objAtt.DisplayName & ” – ” & dateformat

        mi archivo pierde su extensión porque termina así:
        Reporte Julio.xlsx 2017-07-21 17-05

        • Buen dia Jason

          Se tiene que dividir el nombre de la extensión del archivo para que no pierda el formato y aplicarlo (DisplayName & dateformat & Ext), lo he aplicado cortando los últimos digitos cuando lo aplico a un solo tipo de extensión pero en tu caso si lo aplicas a los correos en general surge un problema cuando la extensión varia de cantidad que va de 3 a5 normalmente.

          Igual forma, lo pongo en mi listado de pendientes para hacer un ejemplo donde pueda aplicar a cualquier archivo y extension.

          Saludos.

Deja un comentario...