Saltar al contenido

VBScript para guardar automáticamente archivos adjuntos Outlook

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

Leer:
VBScript - Exportar Tablas Recibidas por Correo a Excel
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

VBScript Crea Carpeta con Nombre del Dominio del Remitente (Sin Extencion .com, .es, .mx, etc) y Guarda Adjuntos en esta Carpeta

En linea 15 se especifica la ruta del folder raiz donde se almacenan los adjuntos.

Nota: Se debe ajustar domain = Left(sDomain, InStr(1, sDomain, “.”, 1) – 1) cuando crea nombres incorrectos cuando el dominio cuenta con mas de un punto.

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

    dateFormat = Format(Now, "yyyy-mm-dd H-mm")
    getFrom = itm.SenderEmailAddress
    sDomain = Right(getFrom, (Len(getFrom) - InStr(1, getFrom, "@", 1)))
    domain = Left(sDomain, InStr(1, sDomain, ".", 1) - 1)
    
    saveFolder = "C:\1-Tests\" & domain & "\"

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

Entradas relacionadas

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.

Comentarios (324)

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

Responder

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.

Responder

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.

Responder

Buen día.
Segui los pasos de creación de la macro, pero al configurar la regla y llamar al scrip veo el ProjectX.saveAttachtoDisk.

Responder

Aclaro, “no” veo ningun scrip, segun instructivo deberia aparecer el “ProjectX.saveAttachtoDisk”

Responder

Buen dia

Puedes anexar el script completo que tienes en el Modulo, para esto entras al Editor de Visual (Alt+F11) y das doble clic sobre el nombre del script.

Responder

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,

Responder

Buen dia

Para que se muestre debes declarar un objeto MailItem ejemplo: Public Sub NOMBRE(ObjItem As Outlook.MailItem).

Nos comentas los resultados.

Saludos.

Responder

Gracias Frenando, efectivamente me faltaba esa declaración del objeto para que outlook lo reconociera al momento de generar la regla.

Muchas Gracias.

Public Sub holamundo(itm As Outlook.MailItem)
MsgBox (“Hola Mundo”)
End Sub

Responder

Buen dia Reyes!

No hay de que, nos da gusto que te hayamos solucionado tu consulta.

Hola, se podria poner el nombre de quien envia el correo en el nombre del archivo?

Responder

Buen dia

Si se puede, solo debes agregar una linea getFrom = itm.senderName lo puedes colocar debajo del dateFormat y agregar en la misma linea donde se especifica el nombre del archivo objAtt.SaveAsFile & getFrom &

Actualice el articulo con el código completo.

Saludos.

Responder

Excelente muchas gracias.

Responder

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…

Responder

Buen dia

Nos complace saber que le fue de ayuda el articulo, respecto a su consulta puede consultar el siguiente articulo para ver si es de su ayuda, lo publicamos en base a su petición hace unos minutos https://www.portalmastips.com/abrir-archivo-xml-en-excel/.

Responder

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

Responder

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.

Responder

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

Responder

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.

Responder

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.

Buen dia

Respondiendo a tu consulta si aun no adquieres ningún software, en el siguiente articulo se publico tu solicitud (Articulo: VBScript para Respaldar o Copiar los Correos de Outlook a una Capeta en el Disco Conservando la Estructura de los Folders.).

Esperamos te sea de ayuda.

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!

Responder

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) & “[email protected]#$%^&*()=+|[]{}`’;:?/,]”

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

Responder

Buen dia

Disculpa la tardanza hemos estado con bastante trabajo y optimizando el sitio para añadir nuevas funcionalidades.

Vamos a escribir un articulo al respecto en la semana, honestamente no hemos aplicado algo similar o visto si se puede, pero debe de poderse con algún macro.

Saludos.

Responder

Buen dia

Te dejamos el enlace al articulo.

https://www.portalmastips.com/vbscript-agregar-numeros-consecutivos-en-asunto-a-los-correos-enviados-outlook/

Esperamos sea lo que buscas
Saludos.

Responder

Hola.

Perfecto. Muchas Gracias

Responder

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

Responder

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?

Responder

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.

Responder

Buen dia

Nos parece excelente que le hayan sido de su ayuda y funcionado como lo requiere el cual es nuestro objetivo compartir nuestro conocimiento y experiencias con ustedes.

Saludos.

Responder

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

Responder

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.

Responder

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

Responder

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.

Responder

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

Responder

Si quisiera modificar la Ruta de Guardado y que fuera

c:documents DATEFormat como podría añadirlo al código??

Muchas Gracias.

Responder

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

Responder

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

Responder

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.

Responder

muchas gracias, lo incluyo al codigo y cuando tenga el codigo de error les comunico, gracias

Responder

Buen dia Jonathan

Una disculpa se me publico la respuesta anterior antes de tiempo, revisa la actualización de la respuesta anterior :).

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

Responder

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.

Responder

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

Responder

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.

Responder

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.

Responder

Buen dia

Muchas gracias por los buenos comentarios :), Motiva saber que les es de ayuda la información publicada en el sitio.

Responder

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, ….

Responder

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 🙂

Responder

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.

Responder

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

Responder

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.

Responder

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

Responder

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.

Responder

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.

Responder

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

Responder

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

Responder

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

Responder

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

Responder

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.

Responder

Gracias por la pronta respuesta, no se que pudo haber pasado pero ya esta corriendo la regla.

Responder

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.

Responder

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.

Responder

Buen dia

Ya realizamos un articulo con los pasos a seguir para respaldar el Mailbox, te dejamos el enlace (Respaldar correo en Outlook (Mailbox Backup)).

Saludos.

Responder

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 🙂

Responder

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.

Responder

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

Responder

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

Responder

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.

Responder

Gracias por la aportación, al igual que a vosotros, no puedo probarlo, el dept. IT no deja por motivos de seguridad.
Un saludo

Responder

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.

¡Son geniales!
Muchas gracias 😀

Responder

Buen dia Angie!

Muchas gracias, nos alegra que te haya servido 🙂
Si tienes dudas o comentarios no dudes en consultarnos.

Saludos.

Responder

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.

Responder

Buen dia

Es la forma en que declaras la funcion del VBScript debes declarar un argumento MailItem Ej: Public Sub Prueba(Obj As MailItem).

Saludos.

Responder

Correcto !!!! …. muchas gracias.

Responder

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

Responder

Buen dia

En la semana o a principios de la siguiente me hare un tiempo para comentarte alguna solución ahorita me encuentro con bastante carga de trabajo; hay que agregar una funcion distinta a la publicada en el articulo ya que hay que guardar los msg temporales y leerlos para guardar los adjuntos.

Saludos.

Responder

De antemano muhas Gracias por tu apoyo y estare al pendiente de la solución.

Saludos.

Responder

Buen dia

En el siguiente enlace encontrara publicado un articulo donde se explica y anexa el VBScript creado para lo solicitado.

Ver Articulo: vbscript-guardar-archivos-adjuntos-de-correos-msg-guardar-adjuntos-de-correos-adjuntos
Esperamos comentarios.

No olvide seguirnos en Facebook y recomendarnos asi para llegar a mas personas.

Saludos.

Hola Buenas Tardes antes que nada te doy las Gracias por el apoyo a mi Pregunta/Duda ya probe los dos vbscript y funcionan perfectamente ya prepare la segunda opcion que es cuando los msg ya estan en disco duro y funciono a la perfección Gracias por el apoyo.

Saludos.

Buen dia Humberto

Nos da gusto que te hayan funcionado, No dudes en visitarnos nuevamente y darnos like en Facebook para que estes al tanto de los nuevos Tips que publicamos.

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.

Responder

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.

Responder

este funciona para primera vez, si deseo q sea un acto automatico cada que llegue un nuevo correo?

Responder

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.

Responder

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 .

Responder

Buen dia

Disculpa la tardanza, en el siguiente enlace encontraras lo solicitado.

https://www.portalmastips.com/vbscript-descomprimir-zip-adjunto-guardar-los-archivos-automaticamente-outlook/

Saludos.

Responder

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!

Responder

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.

Responder

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

Responder

Buen dia Edd Lee!

Script ya listo no tenemos, este mismo podría modificarse para imprimir, te podemos guiar con tu consulta en unos dias mas; hemos tenido un mes bastante ocupado. Esperamos resolver tu consulta mas tardar el 25 del presente.

Saludos.

Responder

Buen dia Eddy Lee!

Respondiendo a tu consulta se realiza el siguiente articulo con el Script, si tienes dudas o comentarios al respecto no dudes en consultarnos;
VBScript – Imprimir adjunto automáticamente al momento de recibir un correo en Outlook
Si tienes consultas favor de realizarlas en el articulo en cuestion.
Esperamos solvente lo que requieres.
Saludos

Responder

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

Responder

Buen dia, nos alegra que te haya funcionado.

Respecto a tu otra solicitud, Se requiere uno nuevo ya que cambia completamente el objetivo de este, tenemos varias solicitudes pendientes por responder primero, en cuando vayamos contestando las solicitudes te apoyamos con el script.

Saludos.

Responder

Es lógico, antes hay mas peticiones, así que esperare mi turno, Un saludo

Responder

Buen dia

Puedes encontrar en el siguiente articulo tu solicitud (AQUI).

Esperamos sea lo que requieres.

Saludos.

Responder

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

Responder

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

Responder

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

Responder

Tengo problemas de los parentesis, al colocar el UCase porfavor un respuesta lo agradeceria

Responder

Buen dia Anthony

Nos puedes pegar el código que estas utilizando e indicarnos la linea en la que tienes el problema.

Quedamos a la espera.

Saludos.

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.

Buen dia Anthony

Requieres nombrar diferente cada Script cambiar Project1VBA, Project2VBA, etc.

Nos confirmas.

Saludos.

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.

Responder

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?

Responder

Listo! eso era. Muchas gracias

Responder

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,

Responder

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.

Responder

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,

Responder

Excelente Luis, esperamos nos escribas como te funciono o nos consultes si tienes inconvenientes.

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!

Responder

Buen dia Cari,

Debe de poderse, en un tiempo libre que tenga la próxima semana mirare acerca de tu consulta.

Saludos.

Responder

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

Responder

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.

Responder

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

Responder

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.

Responder

Gracias estimado, tuve que eliminar todo, reiniciar agregar el script y grabar… todo ok gracias…

Responder

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

Responder

Buen dia Mario

Instalaste algun nuevo sistema de seguridad en tu equipo (Antivirus/firewall)? estos tambien pueden ocasionar que se corrompan los archivos, si no prueba restableciendo Outlook a la configuración default ya que desinstalar y reinstalar outlook no elimina completamente algunas configuraciones. Revisa el siguiente articulo Restablecer Microsoft Outlook a su configuración original / predeterminada dependiendo la configuración de tu servidor de correos te recomiendo respaldar el mailbox completo antes de proceder Respaldar correo en Outlook (Mailbox Backup).

Nos confirmas los resultados,

Saludos.

Responder

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

Responder

perdon es a byte

Responder

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.

Responder

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.

Responder

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

Responder

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)

Responder

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.

Responder

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

Responder

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.

Responder

Buen dia Juan

Encontraras tu solicitud en el siguiente articulo VBScript – Exportar Información de correos Outlook a Excel, favor de hacer los comentarios de seguimiento en el nuevo articulo.

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

Responder

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.

Responder

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

Responder

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.

Responder

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

Responder

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

Responder

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)
End Sub

Saludos.

Responder

Muchas Gracias por la ayuda!!

Saludos

Responder

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

Responder

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)
End Sub

Nos confirmas si es lo que requieres
Saludos.

Responder

gracias por la pronta respuestsa..

si ya quedo

saludos

Responder

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.

Responder

Buen día José

Recibimos tu solicitud, gracias por los buenos comentarios.

Una consulta los XML que recibes traen el RFC en el nombre del archivo o sólo en el campo mencionado?

Responder

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.

Responder

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.

Muy bueno.

Una duda, NO admite scripts Powershell ? Sólo VBA ?
Para versión Outlook 2013 y 2016 ?

Gracias

Responder

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

Responder

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.

Responder

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

Responder

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

Responder

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.

Responder

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

Responder

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

Responder

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!

Responder

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.

Responder

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

Responder

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.

Responder

Okey, muchas gracias. lo voy a probar.. debe ser algo automatizado, ya que ni bien se reciben estos archivos se deben dejar en el servidor para que luego otro Script lo dejé en un servidor UNIX. muchas gracias 😀

Responder

Buen dia Cristian

Esperamos hayas concluido con excito tu propósito.

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

Responder

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

Responder

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.

Responder

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

Responder

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.

Responder

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.

Responder

Buen dia Alexander!

No entiendo bien que es lo que deseas realizar y que es lo que ya tienes, ¿que tipo de datos vinculas?.

Responder

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.

Responder

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.

Responder

hola…realice los pasos propuestos y no me queda lso archivos en la carpeta que asigne …alguien me puede colaborar
gracias

Responder

Buen dia Andrea

Nos puedes pegar cual es el código que estas utilizando.

Saludos.

Responder

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

Responder

Buen dia

Puedes intentar eliminando la diagonal final de la linea saveFolder = “C:Archivos”

Me comentas si ya te guarda, también que versión de Office utilizas?

Responder

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

Andrea Buen dia

Utilizas la misma versión de Office y cual es? revisaste si tienes los Macros habilitados? podemos comenzar por ahi, nos comentas.

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.

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

Responder

Buen dia Jorge

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.

Responder

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

Responder

Buen dia Jorge

así seria

For Each objAtt In itm.Attachments
MSGBOX (“ARCHIVO: ” & SAVEFOLDER & “” & OBJATT.DISPLAYNAME)

Saludos

Responder

Buenos días Fernando.
Cuando meto esa linea , me da:

” error de compilación: Se esperaba: separador de listas o )”

y se marca la linea en Rojo.

Responder

Buen dia Jorge

Revisando nos percatamos que se esta cambiando las comillas a otro formato de comillas
MSGBOX (\"ARCHIVO: \" & SAVEFOLDER & \"\" & OBJATT.DISPLAYNAME)

Saludos.

Responder

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

Buen dia Jorge

Nos alegra leer que encontraste la solución, vamos a verificar la publicación ya que no debe copiar la numeración de las lineas.

Saludos.

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.

Responder

Buen dia Carlos!

Puedes revisar estos articulos,

VBScript – Guardar archivos adjuntos de los correos seleccionados Outlook

VBScript – Guardar Archivos Adjuntos de Correos .MSG Ya Guardados en el Disco Duro

Nos comentas cualquier detalle

Saludos.

Responder

Muchas gracias Fernando O. me ha funcionado a la perfección. Solo le faltaría una instrucción de “On error resume next” :-). En descargas masivas (miles de correos) de carpetas en donde puede haber ficheros archivados, por ejemplo, con Enterprise Vault y en donde falla la descarga del adjunto, si no se pone esta instrucción se acaba parando continuamente la rutina.

Responder

Buen dia Carlos

Excelente consejo, quizás eso resuelva algunos bugs que han detectado algunos usuarios.

Gracias.

Responder

GRACIAS FERNANDO!! estos tips me han salvado la vida!! …gracias.

Responder

Buen dia Victor

Muchas gracias por el buen comentario, no dudes en visitarnos.

Saludos.

Responder

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?

Responder

Buen dia Martin

Si se puede, requieres tener configurado el buzon en Outlook y revisa cual de los scripts del articulo se ajusta mejor a tus necesidades.

Saludos.

Responder

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

Responder

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,

Responder

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.

Responder

Buen dia Javier

Muchas gracias por el buen comentario.

Saludos.

Responder

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:UsersImagenes\"
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

Responder

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.

Responder

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.

Responder

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

Responder

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

Responder

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

Responder

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?

Responder

Buen dia Fernando…no muestra error alguno, probablemente el pst este dañado…gracias por tu atencion.

Responder

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

Responder

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.

Responder

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

Responder

Buen día Fernando C

Este se puede habilitar, en el siguiente articulo se muestran las instrucciones Outlook – Opción ejecutar un script (run a script) no aparece en las reglas

Nos comentas.

Saludos.

Responder

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!

Responder

Buen dia Juan G

Este se puede habilitar, en el siguiente articulo se muestran las instrucciones Outlook – Opción ejecutar un script (run a script) no aparece en las reglas

Nos comentas.

Saludos.

Responder

Que pasa si no viene archivo adjunto? como le hago para crear un IF donde si no trae adjunto haga otra accion?

Responder

Buen dia Benjamin

Así como están los codigos si no viene adjunto no realiza ninguna acción.

Puedes personalizar a como gustes el código no existe problema alguno por esto.

Saludos.

Responder

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.

Responder

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.

Responder

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

Responder

Buen dia Sebastian

Nos alegra escuchar que te sirvieran, gracias por la observación tienes razón el remitente también puede traer caracteres ilegales.

Estamos en contacto.

Responder

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?

Responder

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.

Responder

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.

Responder

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.

Responder

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

Responder

Buen dia Miguel

Hacemos referencia al comentario 916

Saludos.

Responder

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

Responder

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

Responder

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?

Responder

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.

Responder

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.

Responder

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.

Responder

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.

Responder

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

Responder

Buenas, quiero hacer un script que configure mi outlock, eso puede ser?

Responder

Buen dia Emanuel

Configurar outlook con script era utilizado con versiones anteriores a la de outlook 2007 ya que no tomaba algunas configuraciones automáticamente y era algo tardado mas si es posible configurarlo mediante un script que utiliza un archivo de configuración prf previamente creado; ChristopherO publico un script Automatically set up Outlook for users

Responder

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

Responder

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.

Responder

Sin problema Alguno… o por via Zoom

Responder

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.

Responder

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.

Responder

Muchas gracias. Estaré atento esperando. Saludos

Responder

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

Responder

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:UsuariosiecgpDownloadsAdjuntos_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_AllotINTERNET”
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?

Responder

Buen dia Arzuq03

Normalmente con alguna actualización se deshabilitan Macros puedes revisar que esten habilitados

En los siguientes artículos encuentras algunos apoyos Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) y Outlook – Crear y configurar reglas

Excelente dia

Responder

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.

Responder

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

Responder

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.

Responder

Pense que estaba solucionado pero me anticipe en la respuesta… Sigue sin funcionar 🙁

Me podrias proporcionar un par de nombres de los archivos que recibes incluyendo la extensión asi como si esta en mayúsculas y minúsculas el nombre.

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

Responder

Buen dia Jason

1.- Para guardar adjuntos de correos seleccionados tengo el siguiente: VBScript – Guardar archivos adjuntos de los correos seleccionados Outlook
2.- Para tomar la fecha de recepción utilizas ReceivedTime
Ejemplo:

dDate = objItem.ReceivedTime
dateFormat = Format(dDate, \"yyyy-mm-dd H-mm\")
objAtt.SaveAsFile saveFolder & \"\" & dateFormat & \" - \" & objAtt.DisplayName

Excelente dia.

Responder

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

Responder

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.

Responder

Oh muchas gracias, me sirvió!

Una ultima consulta mi estimado Fernando, cómo hago para poner el nombre del archivo antes que la fecha? Lo que pasa es que cuando yo muevo la posición de las variables lo guarda sin tipo de archivo porque queda algo así por ejemplo:

objAtt.SaveAsFile saveFolder & “” & objAtt.DisplayName & ” – ” & dateFormat

Con esto la extension XLS queda adentro y no lo guarda como excel.

FACTURA JULIO.XLSX 2017-0724 – 05-15

Tu ayuda por favor. Gracias!

Responder

Disculpa, se replicó mi consulta anterior.

Gracias!

Responder

Buen dia Jason

No hay problema :).

Excelente dia.

Buenas, correcto, por cada mail con la direccion destino que pongo me sale el mensaje diciendo hola. No obstante debía ser algun error en los ficheros, pues ahora me ha vuelto a funcionar…

Muchas gracias por la ayuda.

Responder

Buenas, finalmente cerré el outlook y lo volví abrir y a día de hoy me ha funcionado… no entiendo porque dejaría de funcionar esos dias…
Gracias por el tiempo empleado. Un saludo.

Responder

Buen dia

Excelente noticia, suele suceder; que funciona en un rato mas ya no.

Responder

Fernando, buenas… seguí todos los pasos para ejecutar script en Outlook y cuan lo ejecuto desde la regla me indica “Regla-nombre error El Script “” no existe o no es valido” poseo Outlook 2016

mi regla se llama DescargaXMLAdjuntos

estoy usando el siguiente script:

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(UCase(objAtt.DisplayName), “.XML”) Or (InStr(UCase(objAtt.DisplayName), “.PDF”))) Then
objAtt.SaveAsFile saveFolder & “” & objAtt.DisplayName
End If
Next
End Sub

Responder

Buen dia Pablo

Me puedes proporcionar el código que tienes en el editor de VB, en base al código que pegaste en el comentario la regla que debes seleccionar es saveAttachtoDisk, si tienes problemas para que te muestre la opción Run a Script revisa el siguiente articulo: Outlook – Opción ejecutar un script (run a script) no aparece en las reglas

Me confirmas.

Responder

Hola Fernando ya no se que hacer ando muy pensativo, lo que pasa es que trato de que se guarden los archivo y comparo y comparo y no doy con el problema. Ayer te comente algo sobre mi problema hasta le puse un Msgbox “hola mundo” para ver si corria el script.
Hoy me pasé por otro post tuyo https://www.portalmastips.com/vbscript-guarda-los-archivos-adjuntos-la-carpeta-del-remitente-catalogado-fecha/ para ver si es que me corre el script con las reglas y parece que el problema esta en que no guarda ningun archivo, pero si me crea las carpetas, no se que podria estar mal ya que solo modificando la ruta en tu codigo deberia funcionar. Espero me puedas ayudar o haber visto un caso similar. Gracias.

Responder

Buen dia Jason

Puedes adjuntar tu código completo con la modificación que realizaste.

Quedo atento a tu respuesta.

Responder

Ahí lo copio, solo cambie la ruta de savefolder, le agregué un msgbox “hola” y uno de “adios”, para ver si corre el script y si me sale, pero nada de nada de descargar los archivos, espero me puedas ayudar porque hasta tensiona esto jeje, de repente has visto un caso similar y me aconsejes. Mi outlook 2010. Muchas gracias.

Public Sub SCRIPT(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”)
Dim w As Integer

MsgBox (“Hola”)

saveFolder = “C:Usersjhuamani.LOYALTYDocumentsZ”
‘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

MsgBox (“Adios”)

End Sub

Responder

Buen dia Jason

Si funciona tu script, realice una prueba en mi equipo.

Te recomiendo quitar la diagonal “” de las lineas

\'Original
objAtt.SaveAsFile saveFolder & \"\" & strFileName

\'Recomendado
objAtt.SaveAsFile saveFolder & strFileName

Ya que en la ruta la estas especificando

saveFolder = \"C:Usersjhuamani.LOYALTYDocumentsZ\"

Por lo tanto el valor de saveFolder sera = “C:Usersjhuamani.LOYALTYDocumentsZ\\NOMBREARCHIVO.EXT”

Solo modifique eso y funciono, en muchos casos no toma en cuenta esto mas en ciertas condiciones si.

Otra cosa que puede evitar que no se ejecute es que tengas mas de un script con el mismo nombre.

Excelente dia

Responder

Buenos días. He utilizado un refrito de las scripts que nos propones para conseguir:
1.- Extraer los adjuntos de los mails seleccionados y recibidos en el inbox en la carpeta seleccionada.
2.- Al tener varios adjuntos con el mismo nombre, he conseguido que me los renombre (1), (2)….
3.- Como a veces el proceso tardaba un tiempo le he puesto un Userform que indique que está descargando adjuntos
3.- Finalmente con un MsgBox me avisa que ha terminado y me propone abrir la carpeta de destino.

Realmente me ha ayudado mucho todo lo leído aquí y para alguien iniciándose en VBA es todo un logro haber conseguido todo esto.

Aun me queda una cosa por conseguir y por mas que busco y pruebo soy incapaz. Quisiera que después de todos estos procesos, los correos seleccionados de los que he descargado los adjuntos se marcaran automáticamente como leídos. Alguna idea de como hacerlo?.
Pego mi script a continuación. Hay algún proceso más que no he detallado, como limpiar la carpeta receptora antes de descargar adjuntos…
Muchas gracias

Sub GuardarAdjuntosNuevo()
Dim FSOI As Object
Dim MyPath As String

Set FSOI = CreateObject(“scripting.filesystemobject”)

MyPath = “Z:Mensajes” ‘< 0 Then ‘si hay algun adjunto
For Each Adjunto In mensaje.Attachments ‘explora cada adjunto en el mensaje
strFileName = Adjunto.DisplayName
‘Revisa si existe el archivo en la carpeta de destino
If FSO.fileexists(Carpeta & “” & 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 = FileName
End If
‘Revisa que consecutivo asignar al nombre (1), (2), (3), etc.
While FSO.fileexists(Carpeta & “” & 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
Adjunto.SaveAsFile Carpeta & “” & strFileName
AttachmentCount = AttachmentCount + 1
Set objAtt = Nothing

‘Adjunto.SaveAsFile (carpeta & Adjunto.FileName)

Next

End If
End If
Next
Unload DESCARGANDO

Dim Pregunta As Integer

Pregunta = MsgBox(“ADJUNTOS DESCARGADOS CON EXITO.MARCA LOS CORREOS COMO LEIDOS.¿DESEA ABRIR LA CARPETA DE DESTINO?.”, vbYesNo + vbExclamation + vbDefaultButton2, “ABRIR CUADRO”)

If Pregunta = vbYes Then

Call Shell(“explorer.exe ” & Carpeta, vbNormalFocus)

Else
Exit Sub

End If

End Sub

Responder

Buen dia David

Leí que tienes inconvenientes al publicar el código, elimine los otros comentarios me lo puedes enviar via correo electrónico Forma de Contacto

Para marcarlos como leídos debes agregar la variable a la que asignas el Mailbox Item (El correo)
MBItem.UnRead = False
MBItem.Save

¿Con limpiar la carpeta receptora te refieres a eliminar los archivos adjuntos guardados?
Si es eso en tu caso seria

FSOI.DeleteFile (\"Z:Mensajes*\")
\'Si llega a marcar error al eliminar en ocasiones es por el tiempo de ejecución del script puedes agregar un tiempo al finalizar
dteWait = DateAdd(\"s\", 5, Now())
Do Until (Now() > dteWait)
Loop

Excelente dia, espero tu correo en caso no puedas añadir la instrucción para marcar como leídos.

Responder

Muchas gracias Fernando. He conseguido solucionarlo. De todas formas te he mandado un mail con el script completo y alguna consulta más a través del formulario de contacto. A ver si con tu ayuda puedo seguir aprendiendo y avanzando en el mundo VBA

Responder

Hola Fernando, buenas tardes.

Muchas gracias por compartir tos conocimientos. Tengo una duda a ver si me puedes dar una mano: necesito que de los correos con un asunto puntual (siempre es el mismo) descargar los adjuntos y guardarlos sin reemplazar los que ya están.

He intentado uniendo códigos, pero no he podido.

GRACIAS POR LA AYUDA QUE ME PUEDAS BRINDAR.

Responder

Buen dia Daniel

Algo que se pueda agregar al nombre del adjunto tal como fecha, hora? o te llegan al mismo tiempo archivos nombrados igual?

Quedo en espera de comentario.

Responder

Se les puede introducir fecha y hora para diferenciar, don procesos automáticos de sistema de los cuales recibo información. El nombre del adjunto siempre es el mismo. Muchas gracias.

Responder

Buen dia Daniel

Hay varios vbscript que te pueden servir en el articulo, no requieres unir, revisa los ultimos 5 scripts esos ya tienen implementado ya sea un contador o la fecha.
Si tienes problemas, me comentas pegando el código que estas utilizando.

Excelente dia.

Responder

Hola Fernando, buenas tardes:

Este es el código que estoy usando, requiero que sólo me guarde los adjuntos de un correo con un nombre específico, el destinatario siempre es el mismo, pero me envía mucha información; el correo se llama “Datos diarios”. No he podido lograrlo.

Muchas gracias por tu ayuda

Public Sub DescargaDeAdjuntos(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment

Dim saveFolder As String

Dim dateFormat

Dim getSubject As String

dateFormat = Format(Now, “ddmmyyyy hh-mm”)

saveFolder = “C:UsersdhmarquezcDesktopDescargas”

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

End Sub

Responder

Buen dia Daniel

Lo que quieres implementar se hace desde la configuración de las reglas, Crear reglas y configurar vbscript Outlook te da las opciones siguientes que se muestran en la imagen.

Me comentas si logras hacer lo que deseas
Excelente dia

Responder

Hola Fernando, buenos días:

Efectivamente yo tengo una regla para que los correos de ese destinatario me lleguen a una carpeta puntual, pero lo que no he conseguido es que los adjuntos de ese asunto lleguen a la carpeta que requiero para que desde allí hagan otro proceso.

La idea es que apenas ingrese el correo con el adjunto, me guarde una copia en la carpeta local y ya desde allí me realice otro proceso.

Responder

Buen dia Daniel

El script es lo que hace, mas debes asegurarte que la configuración de la regla y outlook sea la correcta a lo que tu deseas; asi como tener los macros habilitados y la extensión correcta de los archivos recibidos.

Para probar que se ejecuten los script puedes realizar una prueba con el código

Public Sub test()
msgbox(\"Ejecutado\")
End Sub

Te debe mostrar un mensaje “Ejecutado”, si no lo muestra quiere decir que aun tienes bloqueados los Macros el cual seria la razón por la cual no se guardan los archivos, en el articulo “Como utilizar el Editor VBA en Office (Utilizar Macros VBScript)” puedes ver como habilitar macros.

Me comentas si ya se ejecuto.

Responder

Hola Fernando:

Espero te encuentres bien….Te comento mi problema…resulta que modificando uno de tus script para descargar archivos adjuntos de tipo TXT en la cual se creo una regla par descargarlos y ademas de realizar las modificaciones pertinentes al centro de confianza de Macros en la cual se habilitó todas las macros y tambien verificando que el complemento VBA para Outlook estuviera ACTIVADO… funcionó la primera vez…pero despues de ahi ya no se ejecuto …ni siquiera aparece en el listado de macros en el editor de VBA al quererlo ejecutar…el codigo existe en el Modulo1…..he checado en varios foros y en uno de ellos parece que fue una actualizacion de Outlook de Junio de 2017.

Podrias apoyarme a resolver esto…La version de Outlook que uso es 2016.

En espera de tus comentarios.

Saludos.

Responder

Buen dia Ricardo,

Con la actualización se deshabilita en las reglasla opcion Run Script (Ejecutar script), si es tu caso revisa la siguiente publicacion Opción ejecutar un script (run a script) no aparece en las reglas

Me comentas si es este el detalle.

Responder

Hola, buen día.

Antes que nada me gustaría agradecerte por el apoyo, personas que no sabemos mucho de programación realmente batallamos bastante desarrollando/modificando scripts. Estuve jugando con varios códigos de los que hay por aquí pero no logro realizar la modificación que requiero. Te explico: Recibo facturas diariamente por lo que almacenarlas se vuelve algo tedioso y de plano a veces ni lo hago. Lo que estoy tratando de lograr es crear una condición que chequee si en el correo viene un archivo .xml, de ser cierto debe descargar ese y los demas datos adjuntos (generalmente el pdf de la factura), si no viene xml no debe descargar nada. También estuve jugando con el autoguardado por carpeta con el nombre del remitente pero no logro hacerlo, las carpetas que va creando están vacías o crea carpetas repetidas, lo que hace que en 30 segundos me cree decenas de carpetas vacias con el mismo nombre del remitente pero diferente fecha/hora.

Te agradecería mucho si me apoyas con este tema, ya estuve una buena parte del día batallando con esto y no lo puedo lograr. XC

Saludos y

Responder

Buen dia Moctezuma

Intenta con el siguiente codigo.

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

getFrom = itm.SenderName
saveFolder = \"C:XML\" & getFrom & \"\"

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

For Each objAttc In itm.Attachments
If (InStr(UCase(objAttc.DisplayName), \".XML\")) Then
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 If
Next
End Sub

Excelente dia.

Responder

Fernando, estoy utilizando el código que sugeriste y me da el error ‘-2147024894 (80070002)’ en tiempo de ejecución: No se pudo guardar los datos adjuntos. No se encuentra el archivo…..

esto me pasa cuando el correo posee mas de un archivo adjunto y en este caso tiene un XML y un PDF y se cae en la línea objAtt.SaveAsFile saveFolder & objAtt.DisplayName

que me sugieres?

saludos…
Pablo

Responder

Buen dia Pablo

Me puedes confirmar / pegar el código tal cual lo estas utilizando.

Responder

hola Fernando:

este es el código que estoy usando

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

saveFolder = CStr(Environ(“DOWNLOADXML”))
If Not oFSO.FolderExists(saveFolder) Then
oFSO.CreateFolder saveFolder
End If

For Each objAttc In itm.Attachments
If (InStr(UCase(objAttc.DisplayName), “.XML”)) Then
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 If
Next

End Sub

Responder

hola Fernando:

como te pego el código? lo pegue como texto y no lo acepta la pagina…

Responder

Buen dia Pablo,

Puedes enviarlo por medio del formulario de contacto.

Quedo en espera.

Responder

Fernando, logre determinar el porque del error y se da cuando hace referencia a una carpeta remota y se quiere guardar los dos o mas archivos adjuntos. De hecho a Outlook si elegimos guardar adjuntos y tenemos seleccionado los dos o mas archivos y los queremos guardar a una carpeta remota, da el mismo error.

hola Fernando:
al parecer no quedo registrado lo ultimo que escribi:
logre determinar el error y es porque estoy guardando los datos adjuntos en una carpeta remota. de hecho me pasa lo mismo cuando lo hago desde Outlook de forma manual y debo seleccionar de un archivo para guardar.

que puedo hacer para guardar en carpeta compartida en la RED?

saludos…
pablo

Buen dia Pablo

Excelente, te comento yo utilizo el script para guardar en carpetas compartidas de Red, el folder lo tengo mapeado como una unidad y tengo privilegios como usuario. Por otro lado debe funcionar si asignas la ruta completa \\servidorcarpeta.

Excelente dia

Hola Fernando Disculpa, como haría para especificar de que carpeta quiero que me descargue los archivos adjuntos, ya que quiero que me descargue los adjuntos solamente de la “Bandeja de Entrada” Espero que respondas..
Saludos!!!

Responder

Buen dia Neiser

Los scripts aplican para los correos entrantes (a la bandeja de entrada) que cumplan con la regla especifica que hace que se ejecute el script, si no es por ese lado a lo que te refieres me comentas.

Excelente dia

Responder

Fernando, sólo darte las gracias. Los scripts son plenamente funcionales y la explicación de implementación fácil de seguir.
Mil gracias!!!

Responder

Buen dia Marcelo.

Excelente saber que te funciono, no dudes en visitarnos nuevamente.

Responder

Hola Fernando
Una consulta como hago si deseo que el nombre del archivo del fiel extraido del outlook convserve el nombre del archivo persé,
Estoy usando la siguiente script
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

Pero en el nombre del archivo me sale todo esto:
{BE} CASE-Status-1-YYY-26-Jun-2018-165518.626.pdf

Mi archivo adjunto se llama: Status-1-YYY-26-Jun-2018-165518.626

Quisiera que sólo se llame: Status-1-YYY-26-Jun-2018

Gracias:

Responder

Buen dia Miriam

Se ocuparía depurar en tu equipo con tu configuración ya que te deberia ingresar exactamente el nombre del archivo y no agregar {BE} CASE- Suponiendo que la estructura del nombre no cambia puedes usar lo siguiente:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder, sExtract, sExt As String
saveFolder = “C:XML”
For Each objAtt In itm.Attachments
If ((InStr(objAtt.DisplayName, “.xml”) Or InStr(objAtt.DisplayName, “.pdf”))) Then
sExt = Mid(objAtt.DisplayName, 46, 4)
sExtract = Mid(objAtt.DisplayName, 11, 24)
objAtt.SaveAsFile saveFolder & “” & sExtract & sExt
End If
Next
End Sub

De lo contrario me confirmas para añadir otra función.

Excelente dia.

Responder

Hola, mi consulta es si se puede modificar el nombre al descargarse los archivos. En mi caso, la descarga se da cuando se trata de ciertos remitentes, es por eso que, he especificado “cierto texto” en la dirección de remitente. Dado que se trata de algunas empresas, me serviría mucho que los documentos que se descargan se guarden con el nombre de la empresa o con el criterio del texto que he indicado al script. Asimismo, quiero que este archivo sea reemplazado porque solo es uno por día y no me es relevante guardar un histórico. Gracias de antemano. Saludos

Responder

Buen dia Paul

Si es posible asignar un texto manualmente, en la linea donde esta la sentencia para guardar el archivo se puede agregar por ejemplo:

Si el archivo adjunto se llama: EjemploArchivo.pdf con el siguiente código se obtiene tal cual

objAtt.SaveAsFile saveFolder & \"\" & objAtt.DisplayName

pero si deseas agregar un texto manual por ejemplo: Empresa-EjemploArchivo.pdf debe ser:

objAtt.SaveAsFile saveFolder & \"\" & \"Empresa-\" & objAtt.DisplayName

De igual forma puedes agregar nombre de remitente automáticamente, en los ejemplos del articulo ya se encuentran varias formas desarrolladas.

Excelente día.

Responder

Fernando, agradezco tu respuesta. Probablemente no me dejé entender, error mío. Lo que sucede es que me llegan correos de empresas con archivos adjuntos, las direcciones de quienes los envían tienen la siguiente forma: [email protected] En lo que quería que me apoyes era en poder guardar esos archivos con el dominio de esa dirección de quien envía el correo, en este caso, que el archivo que me llegue se descargue con el nombre “empresa”. Si me llegas a ayudar con esto, no tienes idea cuán agradecido estaré.
A la espera de tu ayuda.
Saludos.

Responder

Buen dia Paul

Actualice el articulo, revisa el ultimo script esta modificado para obtener el dominio y crear una carpeta con este nombre.

Excelente dia.

Responder

Buenas Fernando, era para preguntar si esto sería posible.

Se puede crear un vbscript que cuando se reciba un correo de un destinatario en concreto lo reenvíe a otro u otros destinatarios?

Mi propósito es el siguiente:

Tengo capturada otra cuenta de correo que no es mía, pero tengo permisos para verla; y en esta llegan 200 y picos correo de un destinatario con archivos adjuntos; y lo que pretendo es que cada vez que llegue un correo de este destinatario reenvíe automáticamente el mismo correo a otro destinatario, y que al hacer esto mueva dicho correo recibido a la carpeta de esta cuenta a eliminados.

Gracias de antemano

Responder

Buen dia Manuel

No es necesario un Script para esto, las reglas de Outlook te permiten configurar lo que deseas.

Me comentas si eso te funciona.

Excelente dia.

Responder

hola! antes que nada muchas gracias por la amabilidad de responder todos los comentarios.

si es posible me gustaria dejar una consulta.

tengo este script:

Sub ObtenerAdjuntos()
Dim Adjunto As Attachment
Dim NombreArchivo As String
Dim i As Integer
Dim seleccion As Outlook.MailItem

For Each seleccion In Application.ActiveExplorer.Selection
For Each Adjunto In seleccion.Attachments
NombreArchivo = “C:UsersvwarqxqDesktop – para digitalizarDESCARGADOS DE OUTLOOKG- ” & Format(i, “00 – “) & Adjunto.FileName
Adjunto.SaveAsFile NombreArchivo
i = i + 1
Next Adjunto
Next seleccion
End Sub

y me interesaria hacer que bajo ese mismo codigo descargue solamente los archivos que sean “.pdf”

seria posible?

desde ya muchas gracias y disculpas si este no es el foro para realizar tales preguntas

saludos!

Responder

Buen dia Guillermo

Ocupas agregar una condicion por ejemplo:

If InStr(UCase(Adjunto.DisplayName), “.PDF”) Then
‘Tu Codigo para guardar
End If

Esto debe ir después de tu linea For Each Adjunto In seleccion.Attachments y contener esas lineas hasta el Next Adjunto.

Excelente dia.

Responder

Buenas tardes. Quisiera su apoyo con la siguiente macro. De las que tienes publicada, esta me sirve:

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

…Pero necesito que si el nombre del archivo adjunto contiene “una-palabra-en-especifico” lo guarde con “otro nombre”, el cual será siempre fijo. Ejemplo: si el archivo adjunto se llama “listado de facturas”, por el hecho de contener en el título la palabra “factura” lo descargue pero lo guarde con un nombre fijo, que puede ser “Reporte”. Lo necesito así porque otro programa toma el archivo guardado en una carpeta en específico para alimentar una base automática, pero si cambia el nombre no lo reconoce.

Muchas gracias de antemano.

Responder

Buen dia JeanG

Podria ser asi para anteponer un 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
if(InStr(objAtt.DisplayName, “PALABRA”))
objAtt.SaveAsFile saveFolder & “” & “Reporte-” & objAtt.DisplayName
end if
Next
End Sub

Excelente dia.

Responder

Muchísimas gracias por tu oportuna respuesta.

Tengo 2 consultas al respecto:

– Luego del segundo IF me dice que se esperaba un Then, para que quede así:

if(InStr(objAtt.DisplayName, “PALABRA”)) Then (debo agregarlo?)

– Y lo otro es que intenté agregando el Then pero la macro igual no me funciona, es decir, no me descarga el archivo. Creo que me faltó una parte por explicar en mi pregunta anterior, mis disculpas de antemano. Yo necesito que si el título del adjunto contiene “Una-palabra-específica”, la macro la detecte y reemplace por completo el título y lo guarde con “Otro-título”.

Ejemplo:

Recibo un correo con 2 archivos; se llaman: “Reportes de ventas octubre” y “Reportes mensuales”, necesito que el detecte la palabra “Ventas”, es decir que solo descargue el que contenga en su título la palabra “Ventas” y borre todo el título y lo reemplace por la palabra “Reporte”, es decir: que finalmente el archivo se llamará “Reporte”. (No debe agregarle una palabra al título original sino reemplazar todo, por otro titulo)

Actualmente tengo una macro que me funciona bien, pues reemplaza por completo el nombre, pero el problema es que si me llegan 2 archivos, la macro no sabe a cual de los dos le debe cambiar el nombre, entonces no siempre descarga el que necesito, es por eso que requiero que la macro detecte el título para que sepa cual de los dos descargar y sustituirle el nombre.

Te dejo a continuación la macro que tengo hasta ahora que cambia el nombre por completo pero que no detecta el nombre inicial:

Public Sub VENTAS_DIARIAS (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, “.xlsb”) Or InStr(objAtt.DisplayName, “.xlsx”))) Then
objAtt.SaveAsFile saveFolder & “” & “REPORTE.xlsx”
End If
Next
End Sub

Muy agradecido por tu tiempo y dedicación,

Feliz fin de semana.

Responder

Buenos días. Muy agradecido por tu tiempo y dedicación para responder nuestras consultas.

Creo que me faltó detallar una parte en mi post anterior, mis disculpas de antemano. Yo necesito que la macro lo descargue solo si el nombre del adjunto contiene alguna palabra en específico, por ejemplo: Hay 2 adjuntos en el correo, uno se llama “Consolidado mensual” y el otro “Total de facturas”, entonces si el archivo contiene la palabra “factura” que la macro lo descargue y además que reemplace por completo el nombre original del archivo (“Total de facturas”), no solo que le agregue una palabra, sino que cambie por completo el título. Siguiendo con el mismo ejemplo: si el archivo se llama “Total de facturas”, la macro lo guarde siempre con el nombre “Reporte”.

En resumen, al llegar archivos adjuntos, descargar solo el que contenga la palabra “facturas” en su título, lo guarde en una carpeta específica y con el nombre “Reporte”.

—-
Con la macro que me enviaste me pide un then luego del 2do IF, lo coloqué y deja de aparecer el error, pero igual no me descarga el archivo.

Esta macro que pego a continuación me funciona perfectamente, pues cambia el nombre del archivo como lo necesito, pero si llega más de un adjunto no sabe cual de los dos descargar, es por eso que necesito que evalúe el título.

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, “.xlsb”) Or InStr(objAtt.DisplayName, “.xlsx”))) Then
objAtt.SaveAsFile saveFolder & “” & “Reporte.xlsx”
End If
Next
End Sub

Muchísimas gracias de antemano,

Muchos saludos.

JeanG

Responder

Buen dia Jean

Sobre tu scrips no has intentado utilizando de la siguiente forma, ya que no requieres el otro archivo simplemente cambia la condición OR por AND y que una condición revise que sea “xlsx” y la otra contenga condición revise la palabra “factura” que comentas.

Nota: por el formato de la Web creo se estan cambiando los ” por ” en caso te marque algún error es por eso.

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, “factura”) and InStr(objAtt.DisplayName, “.xlsx”))) Then
objAtt.SaveAsFile saveFolder & “” & “Reporte.xlsx”
End If
Next
End Sub

Me comentas si ahora si comprendí tu consulta.

Responder