Saltar al contenido

VBScript – Exportar Información de correos Outlook a Excel

En seguimiento a la solicitud en el comentario del artículo redactamos el siguiente artículo.

El Script solicitado es para Exportar Información tal como Remitente, Fecha, Asunto, Mensaje. Para de los correos recibidos en Outlook a Excel automáticamente cuando llegan y también poder utilizar con reglas para configurar ciertos remitentes y asunto. El script guarda en el registro de Windows el numero consecutivo de renglón para que no se pierda la secuencia al momento de cerrar Outlook o reiniciar nuestro equipo.

Instrucciones de Uso

1.- Abrir el editor de Visual Basic (ALT+F11).

2.- Insertar un modulo nuevo (Insert > Module).

3.- Copiar el código VBScript.

4.- Debemos crear un documento Excel el cual guardaremos en una ruta de fácil acceso para el ejemplo creamos un folder en C:\1-Tests\test.xlsx, el cual dentro del folder 1-Tests tenemos nuestras pruebas y el archivo llamado test.xlsx es el documento Excel que creamos. Estos datos los especificamos en la linea 30 del código.

5.- En el documento Excel debemos dar un nombre a la hoja en este caso la nombramos Test. Este dato lo especificamos en la linea 41 del código.

6.- Podemos dar formato al documento y poner los encabezados como en la imagen, el código esta configurado para que se salte el primer renglón.

exportar-informacion-de-correos-outlook-a-excel-documento 7.- El registro del valor numérico del renglón consecutivo disponible se guarda en la ruta: HKEY_CURRENT_USER\SOFTWARE\VB and VBA Program Settings\Outlook\received el cual si deseamos reinicializarlo debemos entrar a la ruta anterior y modificar (Tambien podemos eliminar) la llave Current Value Number XLS por el numero 2.

exportar-informacion-de-correos-outlook-a-excel-cambiar-numero-en-registro

8.- Configuramos la regla requerida para ejecutar el Script.

Para mas información de configuración ver: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) y Outlook – Crear y configurar reglas

Código

Option Explicit
Public Sub CopyEmailToExcelWhenArrive(olItem As Outlook.MailItem)
 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 iDefault As Long
'Declare registry
 Dim sKey As String
 Dim lRegValue As Long
 Dim sAppName As String
 Dim sSection As String
'Set name of registry keys
 sAppName = "Outlook"
 sSection = "received"
 sKey = "Current Value Number XLS"
 iDefault = 2
 lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)
 
 Dim currentExplorer As Explorer
 Dim Selection As Selection
 Dim obj As Object
 Dim strColB, strColC, strColD, strColE, strColF, strColG As String
            
' Get Excel set up
'the path of the workbook
 strPath = "C:\1-Tests\test.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
    
 'collect the fields
     strColB = olItem.senderName
     strColC = olItem.SenderEmailAddress
     strColD = olItem.Subject
     strColE = olItem.Body
     strColF = olItem.To
     strColG = olItem.ReceivedTime
     
 
'write them in the excel sheet
  xlSheet.Range("B" & lRegValue) = strColB
  xlSheet.Range("c" & lRegValue) = strColC
  xlSheet.Range("d" & lRegValue) = strColD
  xlSheet.Range("e" & lRegValue) = strColE
  xlSheet.Range("f" & lRegValue) = strColF
  xlSheet.Range("g" & lRegValue) = strColG
  
'Save registry row increment
 SaveSetting sAppName, sSection, sKey, lRegValue + 1
 
     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

Basado un codigo de Diane Poremsky publicado en slipstick

Codigo anterior modificado para no utilizar registro

Ver Codigo
Option Explicit
Public Sub CopyEmailToExcelWhenArrive(olItem As Outlook.MailItem)
 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 iDefault As Long
'Declare registry
 Dim sKey As String
 Dim lRegValue As Long
 Dim sAppName As String
 Dim sSection As String
'Set name of registry keys
 sAppName = "Outlook"
 sSection = "received"
 sKey = "Current Value Number XLS"
 iDefault = 2
 lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)
 
Dim currentExplorer As Explorer
 Dim Selection As Selection
 Dim objOL As Outlook.Application
 Dim objFolder As Outlook.MAPIFolder
 Dim objItems As Outlook.Items
 Dim obj As Object
 
 Dim strColB, strColC, strColD, strColE, strColF, strColG As String
            
' Get Excel set up
'the path of the workbook
 strPath = "C:\1-Tests\test.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
     'Abre la hoja de calculo
     Set xlWB = xlApp.Workbooks.Open(strPath)
     'Especificar nombre de hoja de calculo
     Set xlSheet = xlWB.Sheets("Sheet1")
     'Lee el ultimo registro de la hoja de calculo
     lRegValue = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
     ' Requerido para Outlook 2016 -  si genera espacios en blanco
     lRegValue = lRegValue + 1
     
    On Error Resume Next
    
 'collect the fields
     strColB = olItem.senderName
     strColC = olItem.SenderEmailAddress
     strColD = olItem.Subject
     strColE = olItem.Body
     strColF = olItem.To
     strColG = olItem.ReceivedTime
     
 ' Obtener las direcciones Exchange - Se puede remover si no se utiliza Exchange
 Dim olEU As Outlook.ExchangeUser
 Dim oEDL As Outlook.ExchangeDistributionList
 Dim recip As Outlook.Recipient
 Set recip = Application.Session.CreateRecipient(strColB)

 If InStr(1, strColC, "/") > 0 Then
     Select Case recip.AddressEntry.AddressEntryUserType
       Case OlAddressEntryUserType.olExchangeUserAddressEntry
         Set olEU = recip.AddressEntry.GetExchangeUser
         If Not (olEU Is Nothing) Then
             strColC = olEU.PrimarySmtpAddress
         End If
       Case OlAddressEntryUserType.olOutlookContactAddressEntry
         Set olEU = recip.AddressEntry.GetExchangeUser
         If Not (olEU Is Nothing) Then
            strColC = olEU.PrimarySmtpAddress
         End If
       Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
         Set oEDL = recip.AddressEntry.GetExchangeDistributionList
         If Not (oEDL Is Nothing) Then
            strColC = olEU.PrimarySmtpAddress
         End If
     End Select
End If
'Finaliza Seccion de Exchange
'write them in the excel sheet
  xlSheet.Range("B" & lRegValue) = strColB
  xlSheet.Range("c" & lRegValue) = strColC
  xlSheet.Range("d" & lRegValue) = strColD
  xlSheet.Range("e" & lRegValue) = strColE
  xlSheet.Range("f" & lRegValue) = strColF
  xlSheet.Range("g" & lRegValue) = strColG
  
'Save registry row increment
 SaveSetting sAppName, sSection, sKey, lRegValue + 1
 
     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

Código exportar información de los correos en la carpeta seleccionada de Outlook a Excel de forma horizontal

El siguiente código exporta la información de la carpeta seleccionada o selección de correos de forma horizontal, ver imagen de ejemplo:

Leer:  VBScript - Guardar Correos Entrantes a una Carpeta en el Disco (.MSG) Outlook
Ejemplo exportar informacion de correos forma horizontal
Ejemplo exportar informacion de correos forma horizontal

 

Instrucciones de Uso

1.- Abrir el editor de Visual Basic (ALT+F11).

2.- Insertar un modulo nuevo (Insert > Module).

3.- Copiar el código VBScript.

4.- Debemos crear un documento Excel el cual guardaremos en una ruta de fácil acceso para el ejemplo creamos un folder en C:\1-Tests\test.xlsx, el cual dentro del folder 1-Tests tenemos nuestras pruebas y el archivo llamado test.xlsx es el documento Excel que creamos. Estos datos los especificamos en la linea 35 del código.

5.- En el documento Excel debemos dar un nombre a la hoja o dejar la predeterminada Sheet1. Este dato lo especificamos en la linea 47 del código.

Para mas información de configuración ver: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) y Outlook – Crear y configurar reglas

Option Explicit
Option Explicit
Public Sub CopyEmailToExcelWhenArrive() 'olItem As Outlook.MailItem)
 Dim olItem As Outlook.MailItem
 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 iDefault As Long
                                            
'Bloque Registro Declarar Registro - Se puede eliminar si no se utiliza
 Dim sKey As String
 Dim lRegValue As Long
 Dim sAppName As String
 Dim sSection As String
'Dar nombre a las llaves de registro - Se puede eliminar si no se utiliza
 sAppName = "Outlook"
 sSection = "received"
 sKey = "Current Value Number XLS"
 iDefault = 2
 lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)

'Fin Bloque Registro

 Dim currentExplorer As Explorer
 Dim Selection As Selection
 Dim objOL As Outlook.Application
 Dim objFolder As Outlook.MAPIFolder
 Dim objItems As Outlook.Items
 Dim obj As Object
 
 Dim strColB, strColC, strColD, strColE, strColF, strColG As String
            
'Iniciar Excel
'Ruta del Excel
 strPath = "C:\1-Tests\test.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
     'Abre la hoja de calculo
     Set xlWB = xlApp.Workbooks.Open(strPath)
     'Especificar nombre de hoja de calculo
     Set xlSheet = xlWB.Sheets("Sheet1")
     'Lee el ultimo registro de la hoja de calculo
     lRegValue = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
     ' Requerido para Outlook 2016 -  si genera espacios en blanco
     lRegValue = lRegValue + 1
     
    On Error Resume Next
    
    'Bloque para leer folder actual- se puede remover si no se utiliza
    Set objOL = Outlook.Application
                                                                            
    Set objFolder = objOL.ActiveExplorer.CurrentFolder
    Set objItems = objFolder.Items
    For Each obj In objItems       

    Set olItem = obj                      
        
 'Recolecta los datos
     strColB = olItem.SenderName
     strColC = olItem.SenderEmailAddress
     strColD = olItem.Subject
     strColE = olItem.Body
     strColF = olItem.To
     strColG = olItem.ReceivedTime
     
' Obtener las direcciones Exchange - Se puede remover si no se utiliza Exchange
 Dim olEU As Outlook.ExchangeUser
 Dim oEDL As Outlook.ExchangeDistributionList
 Dim recip As Outlook.Recipient
 Set recip = Application.Session.CreateRecipient(strColB)

 If InStr(1, strColC, "/") > 0 Then
     Select Case recip.AddressEntry.AddressEntryUserType
       Case OlAddressEntryUserType.olExchangeUserAddressEntry
         Set olEU = recip.AddressEntry.GetExchangeUser
         If Not (olEU Is Nothing) Then
             strColC = olEU.PrimarySmtpAddress
         End If
       Case OlAddressEntryUserType.olOutlookContactAddressEntry
         Set olEU = recip.AddressEntry.GetExchangeUser
         If Not (olEU Is Nothing) Then
            strColC = olEU.PrimarySmtpAddress
         End If
       Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
         Set oEDL = recip.AddressEntry.GetExchangeDistributionList
         If Not (oEDL Is Nothing) Then
            strColC = olEU.PrimarySmtpAddress
         End If
     End Select
End If
'Finaliza Seccion de Exchange
 
'Escribe valores en hoja de calculo
  xlSheet.Range("A" & lRegValue) = "Sender Name"
  xlSheet.Range("B" & lRegValue) = strColB
  lRegValue = lRegValue + 1
  xlSheet.Range("A" & lRegValue) = "Sender Email"
  xlSheet.Range("B" & lRegValue) = strColC
  lRegValue = lRegValue + 1
  xlSheet.Range("A" & lRegValue) = "Subject"
  xlSheet.Range("B" & lRegValue) = strColD
  lRegValue = lRegValue + 1
  xlSheet.Range("A" & lRegValue) = "Body"
  xlSheet.Range("B" & lRegValue) = strColE
  lRegValue = lRegValue + 1
  xlSheet.Range("A" & lRegValue) = "To"
  xlSheet.Range("B" & lRegValue) = strColF
  lRegValue = lRegValue + 1
  xlSheet.Range("A" & lRegValue) = "Received Time"
  xlSheet.Range("B" & lRegValue) = strColG
  lRegValue = lRegValue + 2

  'Si no se lee folder actual remover
  Next
  
'Guarda el registro - Si se utiliza registro remover el '
 'SaveSetting sAppName, sSection, sKey, lRegValue + 1
 
     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

Modificación basada en un codigo de Diane Poremsky publicado en slipstick

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

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 (165)

Hola Fernando, es genial lo que haces! He estado leyendo varias de las soluciones que publicas y ahora me surgen mucho más ideas (y dudas!!).

Tengo una consulta para éste script que publicas, crees que se le pueda añadir el nombre de cada uno de los archivos adjuntos en cada correo??

Y aprovechando el comentario, una consulta más, existe algún script para reenviar un correo con cierto texto en el asunto. Sé que ésto se puede realizar desde las tareas simples de Outlook, pero mi interés es que las direcciones de envío vayan en CCO y sólo la mía en CC? Así los remitentes no pueden ver las direcciones del resto.

Desde ya, gracias por la ayuda!
Saludos.

Responder

Buen dia Israel

La segunda consulta no comprendi bien, quieres que al dar responder las direcciones vayan al campo CCO?

Para tu primer consulta claro que si se puede agregar, agregue las lineas necesarias

Option Explicit
Public Sub CopyEmailToExcelWhenArrive(olItem As Outlook.MailItem)
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 iDefault As Long
\'Declare registry
Dim sKey As String
Dim lRegValue As Long
Dim sAppName As String
Dim sSection As String
\'Set name of registry keys
sAppName = \"Outlook\"
sSection = \"received\"
sKey = \"Current Value Number XLS\"
iDefault = 2
lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj As Object
Dim strColB, strColC, strColD, strColE, strColF, strColG, strColH As String

Dim objAtt As Outlook.Attachment
Dim saveFolder As String

\' Get Excel set up
\'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

\'collect the fields
strColB = olItem.senderName
strColC = olItem.SenderEmailAddress
strColD = olItem.Subject
strColE = olItem.Body
strColF = olItem.To
strColG = olItem.ReceivedTime
For Each objAtt In olItem.Attachments
strColH = strColH & objAtt.DisplayName & \", \"
Next

\'write them in the excel sheet
xlSheet.Range(\"B\" & lRegValue) = strColB
xlSheet.Range(\"c\" & lRegValue) = strColC
xlSheet.Range(\"d\" & lRegValue) = strColD
xlSheet.Range(\"e\" & lRegValue) = strColE
xlSheet.Range(\"f\" & lRegValue) = strColF
xlSheet.Range(\"g\" & lRegValue) = strColG
xlSheet.Range(\"h\" & lRegValue) = strColH

\'Save registry row increment
SaveSetting sAppName, sSection, sKey, lRegValue + 1

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

Me funcionó perfecto el script que publicaste, era justo lo que quería mil gracias!!

Sobre la segunda consulta, intento explicarme mejor: Recibo un correo todos los días, el cual reenvío a varios compañeros (alrededor de 70), siempre viene con el mismo título y del mismo remitente; las reglas predeterminadas de reenvío de Outlook no me conviene porque sólo puedes poner direcciones en los campos PARA o CC. La idea sería tener un script que al asociarlo a una regla (que verifique el asunto del mensaje recibido) reenvíe el correo (con adjuntos) a los destinatarios deseados pero en CCO, para ésto, las direcciones de los destinatarios podrían estar dentro del mismo script, ya que éstas direcciones casi no las cambio.

No sé si mejoro o empeoró la explicación!!

Gracias y saludos.

Responder

Buen dia Israel

Redactamos el siguiente articulo VBScript – Reenviar correo a Lista de distribución en CCO (Copia Oculta) Outlook, cualquier duda o comentario al respecto favor que sea sobre el nuevo articulo para seguimiento.

Saludos.

Responder

Saludos gracias por el aporte, necesito algo realacionado con lo que planteas a ver si me puedes ayudar, necesito que la bandeja de entrada y de salida realize por usuario lo siguiente, de outllok se exporte a excel todo el correo entrante con los datos de cada contacto y a su vez cree unas carpetas por usuarios, ademas de eso incluir el adjunto si fuese el caso y pueda abrirse en pdf o xml, las carpetas por usuario deberian ser enviados y recibidos (subcarpetas) y por ultimo crear una especie de alarma que no sea la del outlook que indique revision del correo o responder a tal correo, se que lo que planteo es bastante complicado por eso te escribo, gracias de antemano por la atencion prestada:

Daniel

Responder

Buen dia Daniel!

Para crear las carpetas puedes utilizar otro Macro verifica en este articulo cual se ajusta a tus necesidades “VBScript para guardar automáticamente archivos adjuntos Outlook”

Para que te muestre un Mensaje tipo Popup puedes utilizar este pequeño código lo puedes configurar en otro modulo y ejecutar con regla. el unico problema que no se actualizara la bandeja de entrada hasta que den OK.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim dateFormat
Dim getFrom

getFrom = itm.SenderName
MsgBox \"Tienes un Nuevo Mensaje de: \" & getFrom, vbInformation, \"Nuevo Mensaje\"

End Sub

Responder

Gracias por la informacion, si claro me ayudo mucho en eso estoy, quisiera es que ademas de la carpeta del usuario se cree una subcarpeta con la fecha del envio y dentro de ella el adjunto, y por otro lado que el correo se elimine apenas llegue al outlook que la bandeja se mantenga vacia en ese sentido y todo quede en las carpetas ya seleccionada anteriormente, nose si me puede ayudar con esto, de todas formas muchas gracias por el apoyo. Saludos desde Venezuela

Responder

Buen dia

Daniel Intenta con el siguiente Script, para eliminarlo eso lo puedes hacer desde las reglas de Outlook, que primero ejecute el Script después mueva a Eliminados.

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 & \"\" & dateFormat & \"\"

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

For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & objAtt.DisplayName
Set objAtt = Nothing
Set itm = Nothing
Next
End Sub

Responder

Saludos fernando te explico lo siguiente disculpa que no me he explicado de la mejor manera, entiendo que son varios scripts los que requiero, aqui mi necesidades

1. el script lo requiero para entrada y salida de correos para ambos, todos los contactos, que me almacene en una carpeta en cualquier lugar que yo elija, por usuario y dentro de ello una subcarpeta con la fecha de envio o recepcion sea el caso y finalmente el adjunto, probe el ultimo script pero da un error 76 lo depure y es en la linea de oFSO.CreateFolder saveFolder.

Cada carpeta por usuario deberá tambien crearse dos subcarpetas
1.) “Recibidos”, es decir, los E-Mail´s que me envío “Juanito Pérez”
2.) “Enviados”, donde irán todos los E-Mail´s que yo le envíe a “Juanito Pérez” a lo largo del tiempo.

De esta forma tanto la carpeta “Recibidos” como “Enviados” contendrán carpetas con fechas las cuales contendrán todos los archivos que se adjunten en ese correo en particular (ya sea un correo que recibí o envié). Puedo así tener un respaldo organizado de todos los correos que me envían y que yo envío diariamente a lo largo del tiempo, en otras palabras, poder acceder ordenadamente a todo el contenido del correo por usuario, tipo y fecha.

Finalmente para este punto requiero que las carpetas se ordenen automáticamente según el departamento en donde trabaja el o la que me envío el E-Mail, es decir, las carpetas anteriormente solicitadas, irán dentro de una carpeta llamada “Facturas” que es el departamento en donde trabaja ese individuo en particular.

3.)Los contactos de Outlook generalmente traen información en su tarjeta de contacto, tal como: número de celular, teléfono, E-Mail etc. Es por esto que re-quiero que junto al punto número 1 se extraigan estos datos y se coloquen en un archivo Excel por cada contacto que me escriba un E-Mail. Así puedo tener un respaldo de todos los contactos y así poder comunicarme de manera eficientemente con ellos.

Quizas sean unas locuras lo que pido ayuda, pero es lo que necesito solucionar, sino se puede entenderé no todo en la vida se puede pero si hay que tratar de intentarlo. Gracias de antemano y disculpa

Responder

Buen dia Daniel

He modificado el Script para que no marque el error para la respuesta anterior, este aun no se ejecuta para los enviados ni obtiene los demas datos que solicitas. voy a poner el cola lo que solicitas podria tardar algunas semanas en procesarlo, como les he comentado a otros usuarios tengo otros proyectos primero en fila y también es prioridad no descuidar quien paga las cuentas. Por el momento ajusta el Script con los enviados por mientras se procesa tu solicitud, estamos en contacto.

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\")
Set objShell = CreateObject(\"Wscript.Shell\")
dateFormat = Format(Now, \"yyyy-mm-dd H-mm\")
getFrom = itm.SenderName
saveFolder = \"C:Archivos\" & getFrom & \"\" & dateFormat & \"\"

If Not oFSO.FolderExists(saveFolder) Then
\'objShell.Run (\"cmd /c mkdir\" & saveFolder)
\'Call objShell.Run(\"%COMSPEC% /c mkdir \" & saveFolder, 0, True)
CreateDirs saveFolder
End If

For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & objAtt.DisplayName
Set objAtt = Nothing
Set itm = Nothing
Next
End Sub

Sub CreateDirs(MyDirName)

Dim arrDirs, i, idxFirst, objFSO, strDir, strDirBuild
Set objFSO = CreateObject(\"Scripting.FileSystemObject\")
strDir = objFSO.GetAbsolutePathName(MyDirName)
arrDirs = Split(strDir, \"\")

If Left(strDir, 2) = \"\" Then
strDirBuild = \"\" & arrDirs(2) & \"\" & arrDirs(3) & \"\"
idxFirst = 4
Else
strDirBuild = arrDirs(0) & \"\"
idxFirst = 1
End If

For i = idxFirst To UBound(arrDirs)
strDirBuild = objFSO.BuildPath(strDirBuild, arrDirs(i))
If Not objFSO.FolderExists(strDirBuild) Then
objFSO.CreateFolder strDirBuild
End If
Next

Set objFSO = Nothing
End Sub

Responder

Hola!

Te felicito por el articulo, pero tengo una duda…. La siguiente ruta del registro no existe en mi computador
HKEY_CURRENT_USERSOFTWAREVB and VBA Program SettingsOutlookreceived

Debo crearla?????

Saludos

Responder

Buen dia

Muchas gracias, En ocasiones el VBScript no tiene privilegios para escribir en el registro y si abría que crearla manualmente si se llega a dar el caso.

Saludos.

Responder

Buen dia Fernando, felicitaciones por este increible trabajo, oye esto no aparece en mi computador, que debo hacer?

Responder

Buen dia Andersson

Requerimos un poco mas de detalle, ¿Que es lo que no te aparece? ¿El Registro?, ¿El Script a seleccionar? ¿la información exportada?

Esperamos el detalle especifico.

De igual forma puedes ver: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript), tambien Outlook – Opción ejecutar un script (run a script) no aparece en las reglas y Outlook – Crear y configurar reglas

Responder

Hola Fernando! he realizado todos los pasos solicitados, pero al momento de ejecutar la macro… se abre la ventana donde se listan los nombres de todas las macros que han sido creadas con las opciones (ejecutar , cancelar, paso a paso, modificar, crear, eliminar). El problema es que no aparece el nombre de esta macro “CopyEmailToExcel….” favor ayúdame, SALUDOS!

Responder

Buen dia Fiscofre

No te aparece en el listado de las macros al momento de crear la regla? o estas intentando ejecutar la macro desde el editor de Visual Basic?, si es lo 2do no te lo va a mostrar en ese listado ya que este debe ejecutarse desde una regla.

Responder

Hola Fernando!

Partiendo por felicitarte por todo tu trabajo y muchas gracias por la ayuda que entregas… quería ver si me puedes dar una mano con una macro… necesito crear una macro que me permita seleccionar la carpeta de donde yo quiero exportar los correos a un archivo excel… anteriormente me funcionaba sin problema… pero ahora me di cuenta que no me exporta todos los correos, ya que durante la ejecución se produce una interrupción con el error ’13’ (No coinciden los tipos). a continuación te dejo el código que usaba… sólo necesito exportar datos como la hora de envío, remitente, asunto(es lo mas importante que necesito…), espero me puedas ayudar.

Sub ExportarAExcel()
Dim olns As Outlook.Namespace
Dim myInbox As Outlook.Folder
Dim XLApp As Object
Dim wkb As Object
Dim wks As Object
Dim StartCount As Long
Dim myRecipient As Outlook.Recipient
Dim outlookmessage As Outlook.MailItem

Set olns = Outlook.GetNamespace(\"MAPI\")
Set myInbox = olns.PickFolder

On Error Resume Next
Set XLApp = GetObject(, \"Excel.Application\")
If Err Then
Set XLApp = CreateObject(\"Excel.Application\")
End If
XLApp.Visible = True

On Error GoTo 0

Set wkb = XLApp.Workbooks.Add
Set wks = wkb.Sheets(1)
With wks
StartCount = 1
For Each outlookmessage In myInbox.Items
StartCount = StartCount + 1
.Range(\"A\" & StartCount).Value = outlookmessage.ReceivedTime
.Range(\"B\" & StartCount).Value = outlookmessage.SenderName
.Range(\"C\" & StartCount).Value = outlookmessage.Subject
.Range(\"D\" & StartCount).Value = outlookmessage.SenderEmailAddress
.Range(\"E\" & StartCount).Value = outlookmessage.Body
Next
End With

Set olns = Nothing
Set myInbox = Nothing

End Sub

Responder

Olvidé comentarte que la macro la ejecuto desde un archivo excel, y se detiene en el “Next” Sólo me exporta 26 correos que han llegado a la bandeja de entrada, y ahí se detiene 🙁

Responder

Buen dia Felipe.

Siempre son exactos 26 registros? puede que se este saliendo del rango de la hoja de Excel.
Se debe declarar algo como:

rCount = xlSheet.Range(“B” & xlSheet.Rows.Count).End(-4162).Row

Para que tome el rango.

Porque no adaptas el codigo publicado solo debes cambiar los valores en las lineas (lo que esta despues del punto Ej. “.SenderEmailAddress” por “.ReceivedTime”)

strColC = olItem.SenderEmailAddress
strColB = olItem.SenderName
strColD = olItem.Subject
strColE = olItem.To
strColF = olItem.ReceivedTime

por los tuyos.

.Range(“A” & StartCount).Value = outlookmessage.ReceivedTime
.Range(“B” & StartCount).Value = outlookmessage.SenderName
.Range(“C” & StartCount).Value = outlookmessage.Subject
.Range(“D” & StartCount).Value = outlookmessage.SenderEmailAddress
.Range(“E” & StartCount).Value = outlookmessage.Body

Saludos.

Responder

Buenos dias Fernando,

Estoy gestionando tu macro en mi outlook 2016 y cuando me llega un mail no me realiza el traspaso de información… He probado con otra macro para asegurar que la regla me funcione correctamente y me realiza la macro… Que puede ser que no me ejecute tu macro??

Gracias

Responder

Ya me FUNCIONA! Gracias por el codigo y la atención

Responder

Buenas de nuevo Fernando,

Tras hacer diversas pruebas con la macro en mi PC funciona perfectamente (outlook 2016). Pero cuando copio la macro y pongo la misma configuracion en otro PC con versiones de outlook 2010 la macro no funciona, se que se ejecuta pq si le quito una declaración de variable me da error pero no me copia ninguna información… Puede ser por las versiones?

Muchas gracias!

Responder

Buen dia Carlos

Yo lo he utilizado en Outlook 2007 y 2013, mas no en 2010 pero esta raro ya que es una versión intermedio a la que lo he utilizado, si ejecuta cualquier otro macro? el anterior que estuviste utilizando si lo ejecutaba correctamente?

Responder

Buen día Fernando, tu scrip me resulto excelente, pero no se si me puedas apoyar, manejo varias carpetas de cuentas compartidas en el correo y requiero que bajar la información igual estoy utilizando la exepcion de Outlook.Folder pero sin tener exito

Responder

Buen dia Clara

No comprendo claramente lo que requieres, entiendo que tienes varios Mailbox en Outlook configurados y ocupas exportar la informacion o tienes PSTs con correos?

Responder

bueno de echo manejo las dos formas, no se si puedas apoyarme

Responder

Buen dia Clara

Te paso la idea original de del Codigo el cual exporta a Excel los correos dentro de un folder

Option Explicit
Private Const xlUp As Long = -4162

Sub CopyAllMessagesToExcel()
Dim objOL As Outlook.Application
Dim objItems As Outlook.Items
Dim objFolder As Outlook.MAPIFolder
Dim olItem As Outlook.MailItem
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim vText, vText2, vText3, vText4, vText5 As Variant
Dim sText As String
Dim rCount As Long
Dim bXStarted As Boolean
Dim enviro As String
Dim strPath As String
Dim Reg1 As Object
Dim M1 As Object
Dim M As Object

\'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(\"Sheet1\")

\'Find the next empty line of the worksheet
rCount = xlSheet.Range(\"B\" & xlSheet.Rows.Count).End(xlUp).Row
rCount = rCount + 1

Set objOL = Outlook.Application
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items

For Each olItem In objItems

On Error Resume Next

With olItem

sText = olItem.Body

Set Reg1 = CreateObject(\"VBScript.RegExp\")
\' s* = invisible spaces
\' d* = match digits
\' w* = match alphanumeric

With Reg1
.Pattern = \"(Volumes*(d*)s*Issues*(d*))\"
End With
If Reg1.Test(sText) Then

\' each \"(w*)\" and the \"(d)\" are assigned a vText variable
Set M1 = Reg1.Execute(sText)
For Each M In M1
vText = Trim(M.SubMatches(1))
vText2 = Trim(M.SubMatches(2))
Next

xlSheet.Range(\"B\" & rCount) = vText
xlSheet.Range(\"c\" & rCount) = vText2
xlSheet.Range(\"d\" & rCount) = .Subject
xlSheet.Range(\"e\" & rCount) = .ReceivedTime
\'xlSheet.Range(\"f\" & rCount) = vText5

\' next line
rCount = rCount + 1

End If
\' do whatever
Debug.Print .Subject

End With
Next
xlWB.Close 1
If bXStarted Then
xlApp.Quit
End If
Set M = Nothing
Set M1 = Nothing
Set Reg1 = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing

Set objItems = Nothing
Set objFolder = Nothing
Set objOL = Nothing

End Sub

Responder

No me deja correrlo me dice que no se a definido el tipo definido por el usuario

saludos

Responder

Hola de nuevo

ya pude hacer que funcione, de verdad muchas gracias.

Tengo un problema, cada que llega un correo se cierra el excel y ademas el formato que aparece no me favorece para la visualización de la información

hay algún modo de modificar el formato??

y como puedo evitar que se cierre el excel?

saludos y de antemano gracias

Responder

Buen dia Isaac

Si hay forma de modificar el formato, te paso la documentacion del sitio de Microsoft (Dev Center).

Para que no te cierre el documento marca como comentario de la linea 66 a la 69 en el código.

Saludos.

Responder

Hola Fernando de verdad muchísimas gracias, solo me queda otra duda, tengo configuradas dos cuentas de outlook, como puedo hacer que funcione el script solo con una de ellas??

saludos

y de antemano gracias!

Responder

Buen dia Isaac

Al momento de crear la regla en el paso uno te permite seleccionar cual cuenta (through the specified account)[a través de la cuenta especificada] donde vas a seleccionar cual cuenta es en la que deseas ejecutar el script.

Saludos.

Responder

hola fernando una consulta quiero ejecutar una macro que reenvia correo que llega ala bandeja de entrada , encontre en internet un codigo te lo adjunto :
Private Sub Application_Startup()
‘ esta será la carpeta inspeccionada.
Set oFolderItems = Session.Folders(“[email protected]”).Folders(“Bandeja de entrada”).Folders(“NOVEDAD”).Items
End Sub

‘Private Sub Application_Quit()

‘ MsgBox “Goodbye, ” & Application.GetNamespace(“MAPI”).CurrentUser

‘End Sub
Private Sub Application_Quit()
Set oFolderItems = Nothing
End Sub

Private Sub oFolderItems_ItemAdd(ByVal Item As Object)

Dim oMsg As MailItem
Dim oMoveToFolder As Outlook.MAPIFolder
Dim oNameSpace As Outlook.NameSpace
Dim i, j As Integer

Set oNameSpace = Application.GetNamespace(“MAPI”)
‘ esta será la carpeta a la que moveremos los mensajes una vez procesados (enviados)
Set oMoveToFolder = oNameSpace.Folders(“[email protected]”).Folders(“Bandeja de entrada”).Folders(“Bryan”)

On Error GoTo ErrorHandler

j = oFolderItems.Count
ProgressBox.Percent = 0
ProgressBox.Text = “Wait…..”
ProgressBox.Show

For i = 1 To j
If i 1 Then
ExecPause 1
End If
Set oMsg = Application.CreateItem(olMailItem)
‘Debug.Print oFolderItems(1).Subject

oMsg.Body = oFolderItems(1).Body
oMsg.Subject = oFolderItems(1).Subject
‘ a continuación la dirección de correo electrónico donde serán reenviados los mensajes.
oMsg.Recipients.Add “[email protected]
oMsg.Send
ProgressBox.Increment (100 * i) / j, “Procesado ” & oFolderItems(1).Subject
ExecPause 1
oFolderItems(1).Move oMoveToFolder
Set oMsg = Nothing
Next

ProgressBox.Hide
Set oNameSpace = Nothing
Set oMoveToFolder = Nothing

ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & ” – ” & Err.Description
Resume ProgramExit

End Sub

Private Sub ExecPause()
iPauseTime As Integer
Start = Timer
Do While Timer < Start + iPauseTime
DoEvents
Loop
Finish = Timer
End Sub

.. lo coipie en en thisoutlokksession , pero no se ejcuta nada tienes alguna idea de como ejecutar esta macro ya uqe la necesito para mi trabajo MICROFSOTF 2010..

Saludos

Responder

Buen dia Christian

Cual es tu objetivo con este?

Revisa los siguientes artículos.

VBScript – Outlook reenviar correo y agregar texto automaticamente

VBScript – Reenviar correo a Lista de distribución en CCO (Copia Oculta) Outlook

Si solo quieres reenviar correos se puede utilizar alguno de los códigos mencionados solo editarlo.

Saludos.

Responder

Buen día Fernando, quisiera saber si puedes colaborarme con los siguiente ando con la creación de un sistema que ayude a la asignación y respuesta de solicitudes que llegan al area, por lo cual necesito que Excel extraiga los asuntos y quien envía el correo y del mismo modo cuando sea contestado el correo me notifique de alguna manera en el Excel

quedaría super agradecido si me ayudaras, cualquier duda o sí no fui claro dime si por otro medio es más fácil tu colaboració

Responder

Buen dia Gabriel

El Script lo que hace es leer los datos de cada correo recibido y escribirlos en una hoja de excel llevando un contador para no sobrescribir renglones.
De ahí en fuera requieres ligar los correos mediante un ID, realizar la búsqueda en Excel del mismo para obtener el numero de renglón y escribir que fue contestado.
Creo que te sera mas fácil escribir un script nuevo a modificar este ya que a lo comentado es 1/4 de lo que requieres.

Saludos.

Responder

Muchas Gracias Fernando por tu ayuda

Responder

Hola Fernando, ante mano muchas gracias por tu tiempo para responder las preguntas, soy nuevo en el foro y quisiera saber sí existe una manera de copiar el código ya que no me deja seleccionarlo debe ser porque es una imagen.

al mismo tiempo quisiera comentarte lo siguiente necesito de alguna manera extraer la información de la bandeja de entrada de una cuenta de outlook a excel extrayendo datos como hora y fecha de recibido quien lo envía y el asunto, pero a su vez necesito que cuando este correo sea respondido al que lo envié en excel me diga en otra casilla respondido, de verdad quedaría suprema mente agradecido con tu ayuda.

Responder

Buen dia Gabriel.

Te envíe el código que quieres copiar vía correo electrónico, respecto a lo que comentas los datos que extrae del correo se especifican en las lineas 47 a 52. el cual son las siguientes:

strColB = olItem.senderName ‘Remitente
strColC = olItem.SenderEmailAddress ‘ Correo electronico remitente
strColD = olItem.Subject ‘Asunto
strColE = olItem.Body ‘Cuerpo de correo
strColF = olItem.To ‘Destinatario
strColG = olItem.ReceivedTime ‘Fecha y hora de recepción

De ahí en fuera para que te capture en el Excel si fue respondido requieres ligar los correos mediante un ID, realizar la búsqueda en Excel del mismo para obtener el numero de renglón y escribir que fue contestado / respondido.

Lamentablemente, tenemos unos proyectos en puerta y no estamos realizando personalizaciones; tenemos ya bastantes solicitudes el cual en algún momento deseamos responder.

Saludos.

Responder

Hola Fernando soy nuevo en esto no he podido correr el Script ;( no se porque no me funciona, podrias explicarme por favor

Responder

Buen dia Gabriel

Que versión de Office utilizas?

Lo primero para trabajar con los scripts es tener habilitados los macros, para esto en Opciones > ajustes de centro de confianza > configuración de macro en este los habilitas.
Después abres el editor de VBA de Office en este caso en Outlook, abres un nuevo Modulo y pegas código del vbscript.

Es ta mejor explicado en el siguiente articulo: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript)

Una vez lo anterior debes crear una regla, donde cada que cumpla las condiciones que especifiques se ejecutara el script. (Si no cumple las condiciones configuradas no realizara accion alguna).

Outlook – Crear y configurar reglas

si utilizas Office 2016

Me comentas si se ejecuta.

Saludos.

Responder

Hola Fernando muchas gracias por tu colaboración, ya me funciono , te tengo tres preguntas si no es mucha molestia

1) es posible separar la fecha y hora de llegada del correo, para que queden en dos celdas diferentes?

2) Es posible delimitar el cuerpo del mensaje que queda en el excel?,esto lo necesito porque muchos correos vienen con firmas y espacios entre sí haciendo que la celda de cuerpo quede muy extensa

3) Es posible reinicar el contador?? es q usando un archivo nuevo para extraer los correos me empieza en número de celdas muy adelantado

Muchas gracias por tu tiempo y ayuda

Responder

Buen dia Gabriel

Me alegra que ya te haya funcionado el script, te anexo un codigo respondiendo tus consultas.

1.- Si es posible, se agrego una nueva columna linea 54; en las lineas 53 y 54 se agrego el formato.
2.- También se agrego en la linea 51 el limite, yo lo limite a 50, tu lo puedes ajustar al numero de caracteres que desees.
3.- También es posible reiniciar, en el punto 7 del articulo se explica como hacer esto; si va a ser frecuente te recomiendo que exportes el registro asi cada que quieres reiniciarlo solo ejecutas el archivo del registro. entra al siguiente articulo: Como realizar un respaldo del registro de Windows para que veas la idea.

Código

Option Explicit
Public Sub CopyEmailToExcelWhenArrive(olItem As Outlook.MailItem)
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 iDefault As Long
\'Declare registry
Dim sKey As String
Dim lRegValue As Long
Dim sAppName As String
Dim sSection As String
\'Set name of registry keys
sAppName = \"Outlook\"
sSection = \"received\"
sKey = \"Current Value Number XLS\"
iDefault = 2
lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj As Object
Dim strColB, strColC, strColD, strColE, strColF, strColG, strColH As String

\' Get Excel set up
\'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

\'collect the fields
strColB = olItem.SenderName
strColC = olItem.SenderEmailAddress
strColD = olItem.Subject
\'Left(string,length)
strColE = Left(olItem.Body, 50)
strColF = olItem.To
strColG = FormatDateTime(olItem.ReceivedTime, 2)
strColH = FormatDateTime(olItem.ReceivedTime, 3) \'Cambiar por 4 si se desea en formato de 24 horas.

\'write them in the excel sheet
xlSheet.Range(\"B\" & lRegValue) = strColB
xlSheet.Range(\"c\" & lRegValue) = strColC
xlSheet.Range(\"d\" & lRegValue) = strColD
xlSheet.Range(\"e\" & lRegValue) = strColE
xlSheet.Range(\"f\" & lRegValue) = strColF
xlSheet.Range(\"g\" & lRegValue) = strColG
xlSheet.Range(\"h\" & lRegValue) = strColH

\'Save registry row increment
SaveSetting sAppName, sSection, sKey, lRegValue + 1

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

Saludos.

Responder

Hoa,Fernando muchas gracias por tu ayuda ha sido de mucha ayuda, por ahora no te molestaré más, si llego a tener alguna duda o inconveniente espero contar con tu ayuda muchas gracias

Buen dia Gabriel

Nos alegra que ya este un poco mas ajustado el código a como lo requieres.
Cualquier duda nos consultas.

Saludos.

Hola Fernando, que pena contigo quisiera saber si puedes ayudarme con otra cosa, requiero hacer que cada correo que sea enviado desde mi cuenta no quede una copia guardada en elementos enviados, sino que quede en una carpeta local creada, eso es posible??? esto con el fin de no oucpar espacio del correo

Buen dia Gabriel.

Claro que es posible, mas aun no tengo articulo referente a esto, agendare escribirlo para próximas fechas.

Saludos.

Por algún motivo me deja el body en blanco utilizando tu script tal cual. Me genera información sobre el título del e-mail y sobre la hora de recibirlo pero con el body (que es lo que necesito) no me funciona 🙁 que puede ser?

Responder

Buen dia Sergio

En ocasiones cuando el correo trae saltos de linea se visualiza en Excel como celda en blanco, pero si revisas la celda la información si se encuentra ahí, nos confirmas.
Si te marca algún otro mensaje o error nos comentas para tener alguna noción de lo que puede causar el inconveniente.

Saludos.

Responder

Buenas tardes Fernando,

ENHORABUENA por tus artículos porque son geniales y muy didácticos! El script de este artículo me funciona perfectamente, aunque voy a necesitar una modificación, me gustaría desglosar la información de los correos (que son todos iguales) por columnas. Si el body de mi correo es:

Event: ENTERED: HW Danger/Alarm 2
Location: Grupo 4Grupo 4AlternadorRotorCojinete66C
Severity: 4
Date/Time: 4/5/2017 1:10:27 PM

Quiero obtener en Excel los datos repartidos en 4 columnas:

Event Location Severity Date/Time

¿Es posible con el mismo macro? ¿o hay que hacer uno a parte en Excel para que ponga todos los datos en orden?

Gracias de antemano y un saludo!!

Responder

Buen dia Irene

El script esta desarrollado para tomar el texto plano de cada variable y lo transportarlo a una celda especifica en Excel; no manipula el texto, en este caso el body o cuerpo de correo para el script es un solo elemento.

Tendrías que utilizar algún Delimited Text-to-Columns en Excel para crear la macro para separarlo por el primer símbolo “:” y aplicar Transpose a los datos aun que creo que hay una formula para esto ultimo.

Saludos.

Responder

Buenas Fernando,

Muchas gracias por tu eficacia respondiendo. Ya solucioné el problema y ahora tengo un par de preguntas más:
– ¿Es posible almacenar el número de fila en un archivo distinto a HKEY_CURRENT_USER? Ya que tengo el acceso a esa carpeta restringido con usuario de administrador en el trabajo.
– Si durante la noche cuando no uso el pc llega algún correo de los que debe copiarse, ¿se copia en excel en el momento que llega, al día siguente cuando abro outlook o no se pasa?

Gracias otra vez de antemano, un saludo!

Responder

Buen dia Irene.

1.- Pudemos intentar tomar el ultimo registro con datos con lo siguiente:

Sustituye la linea 21 por esto:

lRegValue = xlSheet.Range(“B” & xlSheet.Rows.Count).End(-4162).Row
‘Requerido en Outlook 2016, eliminar si crea registros en blanco
lRegValue = lRegValue + 1

Sustituye la linea 64 por esto:
lRegValue = lRegValue + 1

2.- Outlook debe estar abierto para ejecutar el script, una vez que se abre (al dia siguiente) este va a procesar todos los correos que cargue en el mailbox.

Nos comentas
Saludos.

Responder

Muchas gracias Fernando, paralelamente lo estaba intentando con Access y por ahora creo que me voy a quedar ahí. Pero he aprendido mucho con tu blog y me llevo una visión estupenda de tu trabajo. Muchas gracias por tu gran ayuda.

Buen dia Irene
Muchas gracias por los buenos comentarios 🙂
Aquí estamos a la orden.
Saludos.

Quiero saber si es posible, que con una macro se pueda contestar un correo en especifico de Outlook o tengo que crear desde cero el correo con Subject, destinararios, etc..

Responder

Buen dia Gustavo,

Si es posible responder automáticamente a un correo, el dia de mañana publico un VBScript para realizar eso.

Saludos

Responder

Buen dia Gustavo

Dale un vistazo al siguiente articulo: VBScript – Responder automáticamente determinado correo electrónico

Saludos.

Responder

Buenas Fernando, oye crees q se podría hacer algo para desde una carpeta de outlook determinada pasar todos los correos que hubiera en esta a excel?
Lo necesario sería el destinatario y el cuerpo del correo que vendría a ser una tabla, pegando en una hoja de excel, pero uno debajo de otro.

Gracias.

Responder

Buen dia Manuel

Revisa el segundo código que acabamos de publicar, exporta los datos uno debajo del otro y de una carpeta seleccionada.

Saludos.

Responder

Fernando he probado el código, no me da error pero no me pasa los correos al archivo, este se queda en blanco.

Responder

Buen dia Manuel

Revisa que tengas habilitados la ejecución de Macros. Esto se menciona en el articulo https://www.portalmastips.com/utilizar-editor-vba-en-office-utilizar-macros-vbscript/.

Nos confirmas.

Saludos.

Responder

Con el seundo código ya se lo lleva al excel.
Fernando lo que me ocurre es que el cuerpo del correo lo deja todo en una misma celda, ¿sabes si se podría poner por celdas independientes, como en columnas?

Ejemplo:

Destalinatario: [email protected]
Cuerpo del correo:

A B C D

1111 12 15 17
1111 16 19 13
1111 22 23 56

Imagina que es una tabla en el cuerpo del correo recibido, y que lo que pretendo es que tal y como hace tu código se lo lleve a excel, pero que no me cambie la forma de la tabla, ubicando cada columna de la tabla del correo en columnas diferentes en excel.

Gracias.

Responder

Buen dia Manuel

En el actual código simplemente copia el texto tal cual sin manipular el contenido lo pega en texto plano a la celda correspondiente de Excel.
Se puede implementar para leer los elementos tabla de los correos pero si toma bastante tiempo, lo mas simple mas no es lo optimo es copiar el cuerpo de correo el problema si contiene mas texto, prueba el siguiente:

Option Explicit
Public Sub CopyEmailToExcelWhenArrive() \'olItem As Outlook.MailItem)
Dim olItem As Outlook.MailItem
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 iDefault As Long
\'Prueba Tabla
Dim doClip As MSForms.DataObject
\'Bloque Registro Declarar Registro - Se puede eliminar si no se utiliza
Dim sKey As String
Dim lRegValue As Long
Dim sAppName As String
Dim sSection As String
\'Dar nombre a las llaves de registro - Se puede eliminar si no se utiliza
sAppName = \"Outlook\"
sSection = \"received\"
sKey = \"Current Value Number XLS\"
iDefault = 2
lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)

\'Fin Bloque Registro

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim objOL As Outlook.Application
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim obj As Object

Dim strColB, strColC, strColD, strColE, strColF, strColG As String

\'Iniciar Excel
\'Ruta del Excel
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
\'Abre la hoja de calculo
Set xlWB = xlApp.Workbooks.Open(strPath)
\'Especificar nombre de hoja de calculo
Set xlSheet = xlWB.Sheets(\"Sheet1\")
\'Lee el ultimo registro de la hoja de calculo
\'lRegValue = xlSheet.Range(\"B\" & xlSheet.Rows.Count).End(-4162).Row
\' Requerido para Outlook 2016 - si genera espacios en blanco
\'lRegValue = lRegValue + 1

On Error Resume Next

\'Bloque para leer folder actual- se puede remover si no se utiliza
Set objOL = Outlook.Application
\'Cambiar CurrentFolder por Selection para exportar selección de correos
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items
For Each obj In objItems

\'Lee el ultimo registro de la hoja de calculo
lRegValue = xlSheet.Range(\"B\" & xlSheet.Rows.Count).End(-4162).Row
\' Requerido para Outlook 2016 - si genera espacios en blanco
lRegValue = lRegValue + 1

Set olItem = obj
Set doClip = New MSForms.DataObject
doClip.SetText olItem.HtmlBody
doClip.PutInClipboard

\'Recolecta los datos
strColB = olItem.SenderName
strColC = olItem.SenderEmailAddress
strColD = olItem.Subject
strColE = olItem.Body
strColF = olItem.To
strColG = olItem.ReceivedTime

\' Obtener las direcciones Exchange - Se puede remover si no se utiliza Exchange
Dim olEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList
Dim recip As Outlook.Recipient
Set recip = Application.Session.CreateRecipient(strColB)

If InStr(1, strColC, \"/\") > 0 Then
Select Case recip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olOutlookContactAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = recip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
End Select
End If
\'Finaliza Seccion de Exchange

\'Escribe valores en hoja de calculo
xlSheet.Range(\"A\" & lRegValue) = \"Sender Name\"
xlSheet.Range(\"B\" & lRegValue) = strColB
lRegValue = lRegValue + 1
xlSheet.Range(\"A\" & lRegValue) = \"Sender Email\"
xlSheet.Range(\"B\" & lRegValue) = strColC
lRegValue = lRegValue + 1
xlSheet.Range(\"A\" & lRegValue) = \"Subject\"
xlSheet.Range(\"B\" & lRegValue) = strColD
lRegValue = lRegValue + 1
xlSheet.Range(\"A\" & lRegValue) = \"To\"
xlSheet.Range(\"B\" & lRegValue) = strColF
lRegValue = lRegValue + 1
xlSheet.Range(\"A\" & lRegValue) = \"Received Time\"
xlSheet.Range(\"B\" & lRegValue) = strColG
lRegValue = lRegValue + 1
xlSheet.Range(\"A\" & lRegValue) = \"Body\"
xlSheet.Range(\"B\" & lRegValue).PasteSpecial \"Text\" \'= strColE
lRegValue = lRegValue + 1

\'Si no se lee folder actual remover
Next

\'Guarda el registro - Si se utiliza registro remover el \'
\'SaveSetting sAppName, sSection, sKey, lRegValue + 1

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

No olvides seguirnos para que estés enterado de nuestros últimos artículos.

Saludos.

Responder

Fernando, para que antes de ejecutar el código se pueda elegir una carpeta con un nombre concreto de forma automática cómo se haría.

Es para que cuando haga clic en el botón de comando se seleccione la carpeta en cuestión y no otra que no desee.
Gracias.

Buen dia Manuel

Remplaza la linea 62 por estas tres lineas

Dim ns As NameSpace
Set ns = GetNamespace(\"MAPI\")
Set objFolder = ns.GetDefaultFolder(olFolderInbox).Folders(\"Test\")

Saludos.

Oye Fernado, estoy trabajando con la segunda parte del código que me pasaste, ahora es sobre excel; tengo que limpiar mucho texto y organizar después de pegar los cuerpor de los correos.

Busco algún bucle que se ejecute siempre y cuando se cumpla una condición.

Ejemplo Hoja Excel

A B C
1 X 1 2
2 1
3 4 2
4 Y 1
5 3

Lo que busco es que en la columna A tome el primer valor de la misma y lo pegue hacia abajo siempre y cuando en la columna B tenga algún valor. Quedaría así:

A B C
1 X 1 2
2 X 1
3 X 4 2
4 Y 1
5 Y 3

Gracias

Responder

Buen dia Manuel

Para eso hay que leer la tabla enviada en el correo y crear las condiciones que requieres, si es algo que deseas aplicar te podemos cotizar el desarrollo de un vbscript que cumpla exactamente con lo que requieres; el cual primero requerimos ponernos en contacto para tener tus requerimientos.

Quedamos a la espera.

Saludos.

Responder

Buen día Fernando, estoy copiando exactamente el código como lo publicas, el excel tal cual mencionas pero no ocurre nada, no aparece nada en el archivo Excel. Que sugeris? Gracias.

Responder

Buen dia Fede

Nos confirmas si tienes habilitados los macros al igual del Add-In Microsoft VBA for Outlook Addin puedes encontrar como verificarlo en el siguiente articulo. Como utilizar el Editor VBA en Office (Utilizar Macros VBScript)

Tambien para hacer la prueba que se ejecutan los VBscript correctamente puedes ejecutar el siguiente:

Sub saveSelectedEmailToTXT()
MsgBox (\"Hola\")
End Sub

Te debe mostrar un mensaje Hola.

Nos confirmas.

Saludos.

Responder

Se resolvió habilitando desde centro de confianza para cualquier macro en ambas aplicaciones, Outlook y Excel.

Otro problema que esta sucediendo: los registros aparecen a partir de la fila 10 o 12, muy abajo, por mas formateado que este el excel, tambien cada tanto deja alguna fila vacía, a que se debe esto? algo a corregir en alguna linea?

Gracias.

Responder

Buen dia Fede Has

Cual de los dos códigos estas utilizando? Y también que versión de Office utilizas.

Quedamos atentos.

Saludos.

Responder

Hola Fernando,

Agradezco tu ayuda, necesito generar un archivo txt con el asunto de cada correo recibido de forma automatica.

Responder

Buen dia Jaime

Para realizarlo automáticamente te recomiendo utilizar Excel puedes eliminar del script la lectura de los campos que no requieres, de otra forma puedes exportar los datos de un correo en especifico a un archivo de texto te adjunto un ejemplo, automáticamente no es posible a TXT con el script adjunto ya que al abrirlo te remplaza el texto.

Sub saveAllEmailSubjectInFolderToTXT()
Dim objItem As Outlook.MailItem
Dim sText As String
Dim objFS
Set objFS = CreateObject(\"Scripting.FileSystemObject\")
Dim sFile As String
Dim objFile
sFile = \"C:1-Tests321.txt\"

Set objFile = objFS.CreateTextFile(sFile, False)

For Each objItem In ActiveExplorer.CurrentFolder.Items
With objFile
.Write vbCrLf & \"--Inicio--\" & vbCrLf
.Write \"Subject: \" & objItem.Subject & vbCrLf & vbCrLf
.Write vbCrLf & \"--Fin--\" & vbCrLf
End With
Next
objFile.Close
End Sub

Saludos.

Responder

Muy buenas!!

Yo concretamente me estoy volviendo loco, no veo porque me salta todo el rato este error:

No se ha definido el tipo definido por el usuario. y el error es en la linea ” Dim currentExplorer As Explorer”

Mil gracias por tu ayuda,
Sven G.D.

Responder

Buen dia SvenGD

Esa linea no se utiliza en el código publicado mas la deje para otro implementar fácilmente por selección, Elimina las lineas 23, 24 y 73, nos comentas si te deja de marcar el error

Saludos.

Responder

Buenas Fernando

Nada no hay manera… no se que ando haciendo mal. Agradezco de todas formas tu contestación y ayuda. Te felicito por tu trabajo con esto.

No se si seria posible que subieras un archivo sample donde este todo esto.

Mil gracias!!
Sven G.D.

Responder

Buen dia SvenGD

¿Que ocupas en el archivo de ejemplo?

En que lineas te marca el error?

Puedes intentar con este codigo, lo depure mas no se si ejecute correctamente ya que no tuve tiempo para realizar prueba.

Option Explicit
Public Sub CopyEmailToExcelWhenArrive(olItem As Outlook.MailItem)
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim bXStarted As Boolean
Dim strPath As String
Dim lRValue As Long
\'Set name of registry keys
lRValue = xlSheet.Range(“B” & xlSheet.Rows.Count).End(-4162).Row

Dim strColB, strColC, strColD, strColE, strColF, strColG As String

\' Get Excel set up
\'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

\'collect the fields
strColB = olItem.senderName
strColC = olItem.SenderEmailAddress
strColD = olItem.Subject
strColE = olItem.Body
strColF = olItem.To
strColG = olItem.ReceivedTime

\'write them in the excel sheet
xlSheet.Range(\"B\" & lRValue) = strColB
xlSheet.Range(\"c\" & lRValue) = strColC
xlSheet.Range(\"d\" & lRValue) = strColD
xlSheet.Range(\"e\" & lRValue) = strColE
xlSheet.Range(\"f\" & lRValue) = strColF
xlSheet.Range(\"g\" & lRValue) = strColG

\'Save registry row increment
lRValue = lRValue + 1

xlWB.Close 1
If bXStarted Then
xlApp.Quit
End If

Set olItem = Nothing
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
End Sub

Responder

saludos y gracias por todo lo que haces aqui, es de muchisima ayuda.

Llegue a tu blog buscando la solución aun problema, tengo que enviar la información de outlook de los correos de una carpeta en especifico, y que se copien los valores de fecha y hora de recepción, subject, y además la fecha y hora en la que se marca como terminado. Me tomaré el tiempo necesario para leer todos los aportes que diste para buscar la solución a este problema. De momento lo hago manual arrastrando los correos a la hoja de excel con la que trabajo.

Saludos

Responder

Buen dia Angel

Gracias por los buenos comentarios y seguirnos.

Si con fecha y hora en la que se marca como terminado te refieres a cuando se marco como leído el correo; el modelo de objetos de Outlook no proporciona datos de este estado (Leído o no leído). [Bueno al menos no tengo conocimiento de una forma para obtener el dato ver propiedades MailItem] de esto en fuera lo demás si se puede obtener, esperamos te sea de utilidad.

Saludos.

Responder

Hola Fernando, buen día

Voy descubriendo el sitio y tus aportes, muy completos y que labor tan noble, muchas gracias.

Estoy viendo que el código es para los correos que llegan, ¿habrá la forma de cambiarlo por los de salida? Viendo el destinatario. Ya que deseo hacer un conteo de los correos que le envío a cada uno de los clientes con fecha, para llevar un control, me sería muy útil.

¿Me ayudas?
saludos y muchas gracias de antemano.

Responder

Buen dia Manuel

Para ejecutar el script al momento de enviar un correo electronico lamentablemente no es posible desde las reglas de Outlook, debe ser desde ThisOutlookSession en el editor de VB el cual se ejecutara para todo correo enviado.
Debes pegar el codigo en ThisOutlookSession cambiar la segunda linea por: Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean) y listo.
Ejemplo:

El inconveniente sera que se aplicara para todo correo enviado y no es configurable como las reglas, si deseas aplicar condiciones se deberan realizar por medio de codigo.

Saludos.

Responder

Hola Fernando,

Muchas gracias por tu labor, me estaba volviendo loco ya que he buscado por todos lados lo siguiente: deseo tomar de Outlook la información de la carpeta de enviados, por lo que entiendo el código que has puesto aquí es para los correos que se van enviando y lo que yo quiero es tomar la información (fecha de enviado, cuerpo del correo, de, para, de todos los correos de la carpeta enviados ¿es eso posible?

Responder

Buen dia Omar

El código que se menciona en el tercer ejemplo te exporta lo que se encuentre en el folder seleccionado, este lo puedes adaptar a tus necesidades, si lo requieres de forma vertical los primeros ejemplos lo exportan de esa forma solo debes realizar el cambio en la parte que obtiene y escribe la información; El codigo se encuentra comentado para facilitarles realizar los cambios.

Exelente dia.

Responder

Hola Fernando

Muchas gracias por todo tu aporte, ayudas a muchos en su dia a dia, tengo un problema, cuando le di aplicar a la regla me salio un error de depuracion y me manda a la ventana del VBA y me señala la linea 21 como no reconocido, luego he visto que has modificado el script y pegue el ultimo que publicaste en el comentario de SvenGD 26 mayo, 2017 at 1:43 am.
Pero ahora la linea 2 me da error también de no reconocido, pls tu ayuda no logro hacerla funcionar.

Responder

Buen dia Juan

Me puedes comentar la version de Office que utilizas, de igual forma prueba el siguiente script.

Option Explicit
Public Sub CopyEmailToExcelWhenArrive(olItem As Outlook.MailItem)
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 iDefault As Long
\'Declare registry
Dim sKey As String
Dim lRegValue As Long
Dim sAppName As String
Dim sSection As String
\'Set name of registry keys
sAppName = \"Outlook\"
sSection = \"received\"
sKey = \"Current Value Number XLS\"
iDefault = 2
\'lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj As Object
Dim strColB, strColC, strColD, strColE, strColF, strColG As String

\' Get Excel set up
\'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
\'Abre la hoja de calculo
Set xlWB = xlApp.Workbooks.Open(strPath)
\'Especificar nombre de hoja de calculo
Set xlSheet = xlWB.Sheets(\"Sheet1\")
\'Lee el ultimo registro de la hoja de calculo
lRegValue = xlSheet.Range(\"B\" & xlSheet.Rows.Count).End(-4162).Row
\' Requerido para Outlook 2016 - si genera espacios en blanco
lRegValue = lRegValue + 1

On Error Resume Next

\'collect the fields
strColB = olItem.senderName
strColC = olItem.SenderEmailAddress
strColD = olItem.Subject
strColE = olItem.Body
strColF = olItem.To
strColG = olItem.ReceivedTime

\' Obtener las direcciones Exchange - Se puede remover si no se utiliza Exchange
Dim olEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList
Dim recip As Outlook.Recipient
Set recip = Application.Session.CreateRecipient(strColB)

If InStr(1, strColC, \"/\") > 0 Then
Select Case recip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olOutlookContactAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = recip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
End Select
End If
\'Finaliza Seccion de Exchange

\'write them in the excel sheet
xlSheet.Range(\"B\" & lRegValue) = strColB
xlSheet.Range(\"c\" & lRegValue) = strColC
xlSheet.Range(\"d\" & lRegValue) = strColD
xlSheet.Range(\"e\" & lRegValue) = strColE
xlSheet.Range(\"f\" & lRegValue) = strColF
xlSheet.Range(\"g\" & lRegValue) = strColG

\'Save registry row increment
\'SaveSetting sAppName, sSection, sKey, lRegValue + 1

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

Buenos días Estimado,

De antemano agradecerte por tu aporte, ha sido muy valioso para el trabajo de medición que estamos haciendo en mi labor diaria.

Te quisiera pedir un apoyo respecto a la exportación de los corres enviados; he logrado configurar lo para que funcione y exporte a un 2do archivo en excel, pero al momento de registrarse la información, solo queda registrado el ultimo correo enviado.

Por alguna razón, no crea un registro historico, sino que se sobreescribre y deja una sola linea en el excel.

El script que uso es el siguiente:

Option Explicit
Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean)
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 iDefault As Long
\'Declare registry
Dim sKey As String
Dim lRegValue As Long
Dim sAppName As String
Dim sSection As String
\'Set name of registry keys
sAppName = \"Outlook\"
sSection = \"received\"
sKey = \"Current Value Number XLS\"
iDefault = 2
\'lRegValue = GetSetting(sAppName, sSection, sKey, iDefault)

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj As Object
Dim strColB, strColC, strColD, strColE, strColF, strColG As String

\' Get Excel set up
\'the path of the workbook
strPath = \"C:1-Teststest2.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
\'Abre la hoja de calculo
Set xlWB = xlApp.Workbooks.Open(strPath)
\'Especificar nombre de hoja de calculo
Set xlSheet = xlWB.Sheets(\"Test\")
\'Lee el ultimo registro de la hoja de calculo
lRegValue = xlSheet.Range(\"B\" & xlSheet.Rows.Count).End(-4162).Row
\' Requerido para Outlook 2016 - si genera espacios en blanco
lRegValue = lRegValue + 1

On Error Resume Next

\'collect the fields
strColB = olItem.ReceivedOnBehalfOfName
strColC = olItem.SenderEmailAddress
strColD = olItem.Subject
strColE = olItem.Body
strColF = olItem.To
strColG = olItem.ReceivedTime

\' Obtener las direcciones Exchange - Se puede remover si no se utiliza Exchange
Dim olEU As Outlook.ExchangeUser
Dim oEDL As Outlook.ExchangeDistributionList
Dim recip As Outlook.Recipient
Set recip = Application.Session.CreateRecipient(strColB)

If InStr(1, strColC, \"/\") > 0 Then
Select Case recip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olOutlookContactAddressEntry
Set olEU = recip.AddressEntry.GetExchangeUser
If Not (olEU Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = recip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then
strColC = olEU.PrimarySmtpAddress
End If
End Select
End If
\'Finaliza Seccion de Exchange

\'write them in the excel sheet
xlSheet.Range(\"B\" & lRegValue) = strColB
xlSheet.Range(\"c\" & lRegValue) = strColC
xlSheet.Range(\"d\" & lRegValue) = strColD
\'xlSheet.Range(\"e\" & lRegValue) = strColE
xlSheet.Range(\"f\" & lRegValue) = strColF
xlSheet.Range(\"g\" & lRegValue) = strColG

\'Save registry row increment
\'SaveSetting sAppName, sSection, sKey, lRegValue + 1

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

Buen dia Enrique

En la linea 49 cambia la B por una C tal como se muestra a continuación
lRegValue = xlSheet.Range(\"C\" & xlSheet.Rows.Count).End(-4162).Row

Este registro es para la persona que envia el correo como esta guardando los correos enviados no existe este registro.

Saludos.

Responder

Muchas gracias por toda la información que compartes, Fernando, ya que es de gran valor.
Llevo muy poco tiempo programando y no consigo localizar una propiedad del correo que me permita identificar unívocamente un correo entrante y su relación con los correos salientes que sean contestación o reenvío del original. ¿Existe dicha variable?

MI idea es tener una base de datos con las cabeceras de los correos entrantes, así como los correos salientes y comprobar el tiempo que se tarda en contestar un correo.

Muchas gracias de antemano.

Responder

Buen dia Jose

Las propiedades del objeto MailItem las puedes encontrar en MailItem Object creo te servirá utilizar la propiedad ConversationID.

Saludos.

Responder

Fernando buenas tardes,
Una pregunta, necesito por favor saber cómo hacer para almacenar el asunto y remitente de un correo en un archivo.txt al momento de eliminarlo ya sea con el botón eliminar o con teclado.

Agradecería enormemente tu ayuda.

Responder

Buen dia Jhonatan

Outlook no cuenta con un evento de accion al eliminar, en el siguiente articulo oficial puedes verificar https://msdn.microsoft.com/VBA/Outlook-VBA/articles/application-object-outlook

Al menos con VBScript no seria posible.

Saludos.

Responder

Gracias Fernando,
He leído el artículo y hay un evento llamado BeforeDelete pero no se cómo implementarlo, podría ser esa la solución y me podrías dar una luz por favor con este tema

Responder

Buen dia Jhonatan

El evento BeforeDelete solo funciona cuando se elimina el mensaje estando abierta la ventana fuera buena opción para ejecutar el script mas genera el inconveniente mencionado si se elimina del listado no realizara acción alguna, Leí que para realizar una acción utilizan BeforeItemMove mas tendría que buscar como se puede implementar al código actual.

Responder

Buenas tardes Fernando:

He usado la propiedad ConversationIndex, ya que la ConversationID, no siempre me da un valor cuando envío la respuesta a un correo.
Utilizando esta opción, tengo los siguientes valores para un correo de entrada y su respuesta:

Entrada———– ConversationIndex :01D2F1B640ADDFD648BF04AD4D13AB59F39056396B7D
Salida———– ConversationIndex: 010209F763AA98FDB7D162BE51282D85423BEEC38EE4A1CF7DE320

Como se puede observar no son iguales, ni tiene una parte en común.

¿puedes darme otra orientación?, ya que por más que investigo, no consigo obtener ninguna información clara.

Gracias por tu ayuda.

Responder

Buenas, es inmensamente eficaz toda la información que he podido contrastar en este artículo.
Hasta hoy, ejecutaba genial una regla que me pasaba tal cuál mencionas en el ejemplo de este artículo, un body de un email y los demás campos, se generaba un registro (visible con REGEDIT) y lo pasaba todo estupendamente a una tabla Excel.
Hará unos días dejé el portátil encendido y ejecuté una regla que comprobase una carpeta con más de 10.000 emails para pasar a un Excel tal cuál tu código, marcándome el inicio de una larga espera nocturna, y cuál es mi sorpresa cuando al día siguiente compruebo que se ha quedado detenido o mejor dicho “colgado” en la fila 3.400 aproximadamente del Excel. El Outlook no obedece por lo que me toca apagar y encender de nuevo.
Pero mi problema empieza cuando vuelvo a ejecutar la regla, ya que no obedece en ningún momento.
Mi necesidad me hace eliminar la regla, el Excel, volver a pegar el código en visual basic script, elimino el registro, y cuando lo genero todo de nuevo, no pasa nada al Excel, ni siquiera genera el registro, por lo que decido escribir al no saber qué más cosas probar…
Eh aquí mi nivel de desesperación para tener que recurrir al “padre de mi aplicativo” que me deja todos los emails que necesito en un Excel para poder manipular dichos datos a mi antojo.

Espero no haberte aburrido demasiado y puedas darme alguna pequeña solución de maestro experto en la temática tratada…
Abrazos!

Responder

Buen dia Jaime

No se actualizo Office? o se habilito el bloqueo de macros?

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

Me confirmas lo anterior.

Excelente dia.

Responder

Buenas Fernando, me fue de gran ayuda el artículo de “Como utilizar el Editor VBA en Office (Utilizar Macros VBScript)” ya que por algún motivo se habían deshabilitado las macros. Muchas gracias.
PD: tocas o tocáis algo de administración de servidores? De qué país sóis y cuál es vuestra empresa por si necesito algo en el futuro?

Responder

Buen dia Jaime

Me alegra leer que ya funciono correctamente.
Escribo desde Mexico, este es un sitio que utilizo de pasatiempo, trabajo de tiempo completo en un corporativo en el departamento de IT.

Que tengas un excelente dia.

Responder

Buen dia Jaime quisiera contar con tu acostumbrada colaboración; quisiera saber si es posible que cada vez que llegue un correo a mi bandeja de entrada se vaya a una carpeta específica si en el correo también va copia ciertos contactos, quedaría agradecido profundamente

Responder

Buen dia Juan

Has intentado utilizar configurar lo deseado por medio de una regla usando la opción Enviado a Personas o Grupo publico? en esta opcion puedes agregar las personas que deben venir en el correo para que la regla se ejecute.

Excelente dia

PD: Mi nombre es Fernando.

Responder

tienes toda la razón, no habia caido en cuenta muchas gracias

Responder

Buen dia Gabriel

Para servirte, me confirmas si te funciono para lo deseado.

Excelente dia.

Responder

Hola Fernando como vas???, enserio que pena moelstarte tanto, pero necesito otra ayuda, necesito que al enviar los correos se vayan directamente a una carpeta del local, mirando las reglas solo deja enviar una copia, es posible que todo correo que sea enviado se vaya a una local sin que quede nada en al carpeta enviados del outlook?

Responder

Buen dia Juan Gabriel

Entiendo por local que lo quieres guardar en una carpeta en la computadora? si es asi revisa el siguiente: Guardar Correos Entrantes a una Carpeta en el Disco (.MSG) Outlook

Debes agregar Item.Delete antes de End Sub, esto para elimina los correos.

Excelente dia.

Responder

Buenos días Fernando, te hablo de Sinaloa, en busca de una solución que me están pidiendo en mi trabajo, me piden que en determinados correos que llegan a una bandeja, o mas bien los correos que tengan una tabla de solicitud de prestamos que venga ya rellenada obviamente por los clientes, se exporte a un excel, se puede agregar ademas de la tabla que viene en el cuerpo, el remitente asunto etc.
este link de abajo es la imagen de la tabla que me mandaran rellenada los clientes.

https://drive.google.com/open?id=0B9lgrdHyZlmhZ1ZWTXlEWXBTcG8

ya se con un boton en una macro en excel o igual con VBA en un modulo al iniciar outllok, o cuando yo jale algun correo a determinada bandeja se active el script, o igual con el boton desde un excel que me exporte en una hoja por separado los correos con esa tabla , o en un excel diferente cada correo para tenerlos separados por cliente. lo que me puedas aportar sera de muchisima ayuda,,ya hice algunos ejemplos de algunos codigos que mencionas arriba, en la mayoria me marca error con el option explicit en esta linea de codigo:
Set olItem = obj

Responder

Buen dia Cristian

Anteriormente solicitaron copiar una tabla, puedes verificar si te sirve el código de la respuesta que le dimos: Comentario ya teniendo el código puedes configurar las reglas para ejecutar el script cuando desees.

Excelente dia.

Responder

Se que es mucho pedir, soy practicante de ingenieria de sistemas y me gustaria saber si podrias hacer un tutorial, ya que nos serviria de mucho para lnosotros. Muchas Gracias

Responder

Buen dia Jhonattan Llanos

Tutorial de que parte del tema en cuestión?

Responder

Estimado me gustaria saber si tienes algun tutorial para poder ver los correos dentro de una hoja de excel automaticamente.

Responder

Buen dia Jhonattan

¿Puedes explicar un poco mejor la solicitud?, Quieres leer los correos en Excel en lugar de Outlook?

Responder

Exacto. lo que pasa es que constantemente nos llegan requerimientos en el trabajo y quisieramos crear un correo donde solo lleguen requerimientos, y esos correos me gustaria poder verlos en filas de excel. Es posible? Saludos

Responder

Buen dia Jhonattan Llanos

Debes realizarlo a través de Outlook, puedes utilizar como base alguno de los scripts en este articulo. Estos exportan los datos de los correos a una hoja de Excel.

Excelente dia.

Responder

Hola Fernado antes que nada queiro felicitarte, tengo una duda tengo varios PST´y no se como indicarle cual el pst correcto y de que folderdebe de extraer la informacion

Responder

Buen dia Kary

El primer codigo exporta los correos entrantes mas no los seleccionados, el segundo si exporta la selección del folder mas el orden de la información cambia; el codigo que indica para exportar el folder seleccionado es:

Set objOL = Outlook.Application
Set objFolder = objOL.ActiveExplorer.CurrentFolder
Set objItems = objFolder.Items
For Each obj In objItems

Puedes ver en el segundo codigo donde se insertaron esas lineas y colocarlas en el primero.
asi como en la 2da linea se dele eliminar el Item quedando asi: Public Sub CopyEmailToExcelWhenArrive()

Excelente dia

Responder

Hola Fernando y buenas noches, tenia una consulta sobre una macro para el outlook.
Lo que ocurre es que en mi trabajo me solicitan que pueda copiar los datos de unos correos, para ser exactos solo “Nombre de la carpeta de donde esta, correo del remitente, el asunto, la hora y la categoria”.
Lo que pasa es que estos correos estan dentro de una carpeta, que esta dentro de otra carpeta, que esta dentro de otra carpeta y asi.
La estructura es la siguiente, La carpeta “Asesores” que es la carpeta raiz por asi decirlo, dentro se encuentran varias subcarpetas con los nombres de los asesores por ejemplo “Mayra” y dentro de esta subcarpeta estan otras carpetas donde se distribuyen los correos dependiendo de su categoria, como por ejemplo “prestamos”, “liquidaciones” etc.
Tengo este codigo que coloca los datos que necesito, lo que pasa es que muestra el nombre de la carpeta en la esta el correo en la Fila 1, pero lo que yo quiero y no puedo lograr es que muestre solo la carpeta del asesor al que pertenece, es decir que diga “Mayra” o “Jose” dependiendo de a que asesor corresponde.
Con este codigo me permite seleccionar la carpeta raiz y copia todos los datos de los correos pero terminan como antes mencione.

Para explicar mejor las carpetas estan asi dentro del Outlook:
Asesores/Nombre del asesor “que es el dato que necesito”/Carpetas con el nombre de la categoria.

Crees que me puedas ayudar?, Mucha gracias de ante mano y saludos.

Codigo:

Public xlSht As Excel.Worksheet

Sub DocumentFolders(objParent As folder, lRow As Long)
Dim objItm As Object
Dim objFolder As folder

On Error Resume Next
With xlSht
For Each objItm In objParent.Items
.Cells(lRow, 1) = objParent
.Cells(lRow, 2) = objItm.SenderEmailAddress
.Cells(lRow, 3) = objItm.Subject
.Cells(lRow, 4) = objItm.ReceivedTime
.Cells(lRow, 5) = objItm.Categories
lRow = lRow + 1
Next
End With
On Error GoTo 0

If objParent.folders.Count > 0 Then
For Each objFolder In objParent.folders
Call DocumentFolders(objFolder, lRow)
Next
End If

End Sub

Sub Exportar_datos()
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim folder

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Add
Set xlSht = xlWb.Sheets(1)

With xlSht
.Cells(1, 1) = \"Carpeta\"
.Cells(1, 2) = \"Correo\"
.Cells(1, 3) = \"Asunto\"
.Cells(1, 4) = \"Hora\"
.Cells(1, 5) = \"Categoría\"
End With

Call DocumentFolders(Session.PickFolder(), 2)

xlApp.Visible = True

Set xlSht = Nothing
Set xlWb = Nothing
Set xlApp = Nothing

End Sub

Responder

Buen dia Richard

Permiteme revisar tu código para darte una respuesta.

Excelente dia.

Responder

Muchas gracias.
Cualquier aporte sera bienvenido.

Responder

Buen dia Richard

Mira con una función puedes hacer lo siguiente:
1.- En el principal indicarías la carpeta donde tienes los correos por ejemplo: mis pruebas las realice desde un Folder Personal que es “Correos Anteriores” y un sub carpeta “Asesores”, se indicaría de la siguiente forma:

Dim olStartFolder As Outlook.MAPIFolder \'Declaracion
Set olStartFolder = olSession.Folders(\"Correos Anteriores\").Folders(\"Asesores\")

Otra opcion es si tu seleccionas la carpeta, tienes dos opciones que la solicite al momento de ejecutar el script o tomar la que tienes activa en Outlook:

Opcion a
Set olStartFolder = olSession.PickFolder

Opcion b
Set olStartFolder = Application.ActiveExplorer.CurrentFolder

2.- Llamas la función enviando la selección.
If Not (olStartFolder Is Nothing) Then
\' Start the search process.
ProcessFolder olStartFolder
End If

3.- La funcion obtiene las carpetas dentro del folder indicado.

Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
Dim i As Long
Dim olTempFolder As Outlook.MAPIFolder
For i = CurrentFolder.Folders.Count To 1 Step -1
Set olTempFolder = CurrentFolder.Folders(i)
strFolders = strFolders & vbCrLf & olTempFolder
lCountOfFound = lCountOfFound + 1
Next
End Sub

Excelente dia

Responder

Hola Fernando.
Muy interesante todo esto que posteas.
Quisiera ver si me puedes ayudar :
1.- Funciona para outloock de off 365 ?. Me dicen de microsoft que los script no funcionan para off 365, entonces quiero saber para ver si me pongo a leer tu post y aplicarlo.
2.- Tengo 2 necesidades de los correos que entran, en ambas es generar un excel
2.a.- El correo trae solamante texto (texto plano) de cual requiero los campos elementales (asunto, fecha, cuerpo,, etc)
2.b.- El correo trae una tabla de datos de la cual requiero extraer los datos

gracias, saludos

Responder

Buen dia Sergio

Para ser honesto desconozco el funcionamiento de Office 365, las migraciones que he realizado han sido en las versiones 2007, 2010, 2013, 2016 el cual esta comprobado que funcionan; mas he escuchado algunos usuarios que “Si aplican algunos scripts” en Office 365, tambien en la comunidad de Microsoft he leído que tiene soporte a VBA.

Prueba cualquier script y nos comentas para tener conocimiento si funciona.

Excelente dia

Responder

Buen día Fernando.
Primeramente gracias por contestar, me gusta.

Probé con un script para mandar correos repetitivos en determinado período de tiempo, lo tome de un soporte de Microsoft, no funcionó, se hizo para 2010 en su momento, por cierto lo resolví con google.
Consulte 2 veces a Microsoft vía chat y teléfono, distintos asesores, diferían en su respuesta, uno de me dijo que en off 365 ya no se usan los script (no le creí, quedaría rezagados con la competencia y no veo la razón.) y el otro me dijo que debería, me paso unas ligas de ayuda, nada que ver. Entonces ando investigando la realidad.

Cuando sepa algo lo aportaré por y a este medio.

Volviendo a mi consulta original.

– Hay forma de hacerte llegar un correo ?, aparentemente trae una tabla (no como Excel) que no es imagen, contiene texto. Quisiera saber si se puede extraer la información, en caso de que si, no dudaría en migrar a un outlook anterior.

Gracias por tus atenciones

Responder

Buen dia Sergio

A lo visto, deben funcionar en 365 ya has logrado ejecutar un script sencillo tal como

Sub Main()
MsgBox(\"Hello, World!\") \' Display message on computer screen.
End Sub

Debes asegurarte que tengas Macros habilitados y se muestre la opción Ejecutar Script.

Respecto la tabla por el momento no tengo script que extraiga solo los datos de la tabla que se encuentra en el cuerpo del correo, realice una modificación algunos comentarios atrás VER el cual hace la acción de copiar y pegar el cuerpo del correo, por lo tanto las tablas se pegan en Excel en su celda correspondiente cada dato.

Por otro lado seria posible siempre y cuando sea una tabla y el formato de correo sea HTML, este código no esta implementado en el código mencionado en el articulo, ya que pueden existir otras variantes a tomar en cuenta el cual por motivos de tiempo no he tenido oportunidad, esta solicitud aun la tengo pendiente ya que la han solicitado varias ocasiones, en algún momento les traeré ese código.

\'Leer HTML de cuerpo de correo
Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
With oHTML
.Body.innerHTML = oMail.HTMLBody
Set oElColl = .getElementsByTagName(\"table\")
End With

\'Importar a Excel
Dim x As Long, y As Long

For x = 0 To oElColl(0).Rows.Length - 1
For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
Range(\"A1\").Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
Next y
Next x

Excelente dia

Responder

Buen día Fernando.

Primeramente gracias por contestar, muy bien.

Al no poder que se ejecutara un script que está en la página de soporte de Microsoft para enviar correos repetitivos en un periodo definido, consulté en Microsoft. Aclaro que el post correspondía para Outlook 2010

Dos asesores me atendieron en consultas diferentes, diferían de sus conocimientos
– uno me dijo que en off 365 no funcionaban los script, no le creí ya que es una buena herramienta y de ser así quedaría en desventaja con su competencia.
– el otro me dijo que deberían funcionar los scripts, me proporciono unas ligas de ayuda, nada que ver

He estado leyendo sin encontrar tema acerca de off 365, fue que llegue a tu página.

Seguiré sobre el tema, cuando tenga algo que proporcionar lo haré en este medio.

Volviendo a la consulta original
– en el 365 s puede exportar varios campos de los correos, me topo con que el cuerpo de mi correo trae una tabla (no imagen) de la cual quiero extraer la información
– Hay forma de hacerte llegar un correo para que la evalúes y me ayudes para ver si se puede extraer la información ?, si es necesario migrar a un Outlook versión anterior, no dudaría en hacerlo.

gracias

saludos

Responder

Buen dia Sergio

Los comentarios se quedan en moderación por eso no se muestran hasta que yo los lea, es por motivo de control para poder responder todos los comentarios que realicen en el sitio.

Ya te di respuesta en el primero comentario.

Excelente dia

Responder

Hola fernando, tengo una duda, me funciona de maravilla tu Macro para exportar los datos a excel muchas gracias!! pero me gustaria saber si puedo exportar también los datos adjuntos , por ejemplo una planilla excel personalizada a cada proveedor.

Muchas gracias por tu tiempo !

Responder

Buen dia Gabriel

No comprendí exactamente que requieres, tengo algunos scripts para guardar los adjuntos automáticamente, así como Guardar los Archivos Adjuntos en Carpetas Especificas Automáticamente Outlook.

Excelente dia.

Responder

Hola fernando, gracias por la rápida respuesta.
seré mas especifico.
Usé dos macros, una para guardar los mensajes en excel y agregue otra para guardar los adjuntos.
la primera como te comente funciona perfecto.
La segunda para guardar los adjuntos, realicé la creación de la carpeta pero no me guarda los archivos.
tengo las reglas en orden, las macros funcionando y todo.
o quizá outlook guarde los archivos en una carpeta especifica?…

Saludos,
Gabriel

Responder

Buen dia

Para guardar los adjuntos utilizaste alguno de mis scripts?, de ser asi ¿cual utilizaste?, y si realizaste algún cambio a este ¿cual fue?.

Quedo en espera.

Responder

Buenas noches Fernando…!!!

De verdad muchas felicidades, eres un master con los codigos estoy leyendo algunos para ver si alguno se apega a mis necesidades, y creo que uno si, pero mejor pregunto??

Me solicitan que de los correos solo busque en la redacción NOMBRES del personal, hasta el momento tengo 600 correo que tengo que revisar un por uno y seleccionar el nombre y pasarlo a excel, se pude crear una macro que me busque este dato??

Espero me puedas ayudar, gracias

Excelente Noche

Responder

Buen dia Carlos

Se puede realizar búsquedas en el cuerpo del correo, siempre y cuando se tenga que es lo que se va a buscar; mas no es posible especificar que extraiga nombres porque no se puede diferenciar las palabras; para el script todo el contenido del correo son palabras.

A diferencia si el cuerpo de correo viene en un formato especifico es posible extraer partes del cuerpo de correo, el cual si el correo cambia la estructura tomara otros valores.

¿Cual es tu caso?, ¿Tienen un parámetro en común en los correos?

Responder

Buenas noches fernando como estas….!!! una disculpa por no contestar en el momento pero se me junto un poco el trabajo, y uno de ellos es pasar del correo de OUTLOOK a excel los nombres de personas que me van mandando diarios, es una lista de personas que ingresaron en otros estados o se dieron de baja como tal el correo viene de la siguiente manera:

para: Carlos
de: Recursos Humanos
Titulo: Altas de personal Puebla o Bajas (segun sea el caso)
————————————————————————————————
pedrito perez
Fernando cepeda
felicia fernandez

Atentantamente
Recursos humanos

Como tal solo selecciono los nombres y los paso a excel, y diariamente son de 30 a 40 correos y ya te imaginaras, es un poco tedioso, crees que haya alguna manera mas facil de seleccionar estos parametros.

Excelente dia, espero me puedas ayudar.

Saludos.

Responder

Buen dia

Para poder realizar una selección se debe contar con un formato ya establecido para poder indicar en el script (tomar de tal a tal renglón) ya que el script por si solo no podria detectar que es un nombre y que no, asi que en el caso te exportaría la firma y cualquier otro comentario; actualmente eso es lo que hace el script seria cuestion que adaptaras para que solo descargue el cuerpo del correo.

Excelente dia

Responder

Hola, Fernando! Muy buena la publicación!

Te hago una consulta. Yo nunca armé una Macro en Excel, y para el trabajo me pidieron intentar armar una que tome datos de unos archivos adjuntos que llegan por mail, y actualicen un libro de un archivo de Excel. Estuve buscando, y todos los ejemplos son con Outlook. El problema es que en el trabajo utilizamos Lotus Notes.

Tenés idea que podría llegar a utilizar para lograr esta funcionalidad? O dónde puedo buscar?
Muchas gracias!!

Responder

Buen dia Joaquin

Lamentablemente no tengo experiencia alguna con Visual Basic para Lotus Notes, este también tiene capacidad de integrar Visual Basic mas si cambian referencias, objetos, etc. IBM tiene un foro de desarrollo, creo lo mas apropiado sera que realices la consulta en este.

Excelente dia.

Responder

cuando voy a buscar en el registro del sistema la ruta que señalas HKEY_CURRENT_USERSOFTWAREVB, no me aparece en el listado, ahi que esta ocurriendo o que hago??

Responder

Buen dia Alberto,

Puedes crear las llaves manualmente o también puedes utilizar el código que se encuentra plegado debajo del código que estas implementando.

Excelente dia.

Responder

Buenos días, Fernando:

Estoy buscando una forma de ver los correos respondidos en menos de 48 h, pero no veo manera. Había pensado en buscar alguna columna que me mostrara la Fecha de respuesta, que junto a la Fecha de recibido, me permitiera exportar un listado a Excel y gestionarlo en la hoja de cálculo, pero no encuentro ese parámetro. ¿Hay alguna forma de obtener esa información?

Muchísimas gracias.

Responder

Buen dia Lois

Anteriormente ya me habian consultado algo similar el cual investigamos si Outlook ya integraba alguna referencia para vincular los correos de entrada con los de salida, mas llegamos al entendido que se debe realizar mediante código con los IDs de los correos, por el momento no tengo algo ya escrito que te pueda servir. 🙁 de igual forma si llegas a encontrar algo te agradecería retroalimentacion.

Excelente dia.

Responder

Buenos dias disculpe la molestia tengo un problemita en el codigo de importacion de excel cuando ejecuto la macro me presenta un error en la linea 9 de especificacion del libro y revise y esta bien el nombre ize varias veces prueba pero aun me sale ese error me podria dar alguna solucion

Responder

Buen dia

Normalmente el error es en la ruta, asegurate que esta bien escrita entre comillas “ruta” al igual el nombre de la hoja sea la misma que se especifica en el codigo, de igual forma si haces debug al codigo te debe llevar a donde este se detiene, si puedes envíame una captura de pantalla por medio de snag.

Excelente dia.

Responder

Buenos días, Fernando:

Ya pude hacer correr el script el problema es cuando lo intento hacer que corra en una regla de outlook ya que cuando lo inserto en la misma y me llega un correo no aplica el script y mi otra duda es si cuando me llegue un correo se escribiria en la parte final de la tabla o me cargaría todos los correo de la bandeja

de antemano gracias por el script y espero tu respuesta

Responder

Buen dia Alan

Debes verificar que este configurada correctamente tu regla de Outlook puedes revisar los siguientes artículos y me comentas si ya realizaste lo mencionado:

1.- Como utilizar el Editor VBA en Office (Utilizar Macros VBScript)
2.- Outlook – Crear y configurar reglas
3.- Outlook – Opción ejecutar un script (run a script) no aparece en las reglas

El script cada que se ejecute debe ingresar el correo recibido al final de la tabla.

Por otro lado revisa el script que se encuentra justo debajo del primer codigo, lleva el titulo Codigo anterior modificado para no utilizar registro.

Excelente dia.

Responder

Buenos días, Fernando:

Tengo un problema a la hora de colocar el script en una regla del correo, no la esta tomando ya que cuando recibo el correo no ejecuta el script ya probé el si funciona el código y si lo hace en el apartado de visual basic pero a la hora de colocarlo en la regla no la toma espero que me puedas ayudar y una duda cuando se ejecute el código cada vez tomaría todos los correo o solo tomaría el nuevo correo que llegue y lo agregue a la lista ya creada??

De antemano gracias y espero tu respuesta

Responder

Buen dia Alan

favor de revisar la respuesta a tu comentario anterior, quedo en espera de comentarios.

Excelente dia

Responder

Buenas tardes , primero que nada un millón de gracias por toda tu ayuda . La pagina en verdad me ha servido muchísimo.
Tengo una duda; aplique el script y funciona todo super bien , pero en la dirección el remitente (“olItem.To”) me aparece sólo el nombre de las personas y no su dirección de correo electronico . Segun entiendo es por que la persona que mando el correo tiene esa dirección en su libreta de direcciones . ¿Hay alguna forma de que se incluya el correo completo ?

Responder

Buen dia Javier

Añade las siguientes lineas de código después de las lineas comentadas como ‘collect the fields

Dim strRecipients As String
Dim Recipient As Outlook.Recipient
For Each Recipient In olItem.Recipients
strRecipients = Recipient.Address & \"; \" & strRecipients
Next Recipient

strColF = strRecipients

Me comentas.

Excelente dia

Responder

Wow! Que barbaro , funciona muy bien. Mil gracias Fernando
Una duda, si quisiera que solo me pusiera los datos de los correos que estan en la sección “Para” , es posible? con la macro de arriba me incluye a los que estan en “CC” . El problema que tengo con eso es que todos los que estan en esa sección son miembros de la empresa, por lo cual me aparecen dominios muy largos , pero no su correo . Por ejemplo: en lugar de Marcos Perez me sale /o=First Organization/ou=Exchange Administrative Group (FYDIBOHF23SPDLT)/cn=Recipients/cn=517e73b7337e49f9914e94de2fa23626-Marcos Perez….

Lo que necesitaría seria solo saber los correos externos , esos siempre los ponen en “Para”

Ojala se pueda , sino de cualquier forma me es muy muy util

Responder

Buen día Javier

Coloca el siguiente código despues del comentado anteriormente.

\' Obtener las direcciones Exchange - Se puede remover si no se utiliza Exchange Dim olEU As Outlook.ExchangeUser Dim oEDL As Outlook.ExchangeDistributionList Dim recip As Outlook.Recipient Set recip = Application.Session.CreateRecipient(strColB) If InStr(1, strColC, \"/\") > 0 Then Select Case recip.AddressEntry.AddressEntryUserType Case OlAddressEntryUserType.olExchangeUserAddressEntry Set olEU = recip.AddressEntry.GetExchangeUser If Not (olEU Is Nothing) Then strColC = olEU.PrimarySmtpAddress End If Case OlAddressEntryUserType.olOutlookContactAddressEntry Set olEU = recip.AddressEntry.GetExchangeUser If Not (olEU Is Nothing) Then strColC = olEU.PrimarySmtpAddress End If Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry Set oEDL = recip.AddressEntry.GetExchangeDistributionList If Not (oEDL Is Nothing) Then strColC = olEU.PrimarySmtpAddress End If End Select End If

Excelente día

Responder

Hola Fernando
Mis felicitaciones por la gran labor que haces al compartir tus conocimientos, una enorme ayuda para nosotros los legos en la materia.
Tu código para el export Outlook a Excel funciona muy bien, lo he compartido con mis compañeros, están felices.

Por favor una consulta:
Los correos que recibo los almaceno manualmente, después de leerlos, en carpetas especificas, de acuerdo al tema que tratan.
Es posible un código que en el Excel deje en una columna el nombre de la carpeta donde fue leído?
Que chequee en el Excel si el email ya existe y no lo copie si existe
Este código lo ejecutaría, desde la carpeta outlook raíz, manualmente una vez al final del día a través de una regla que considere las subcarpetas.
Muchas gracias
Excelente dia

Responder

Buen dia Eduardo

Gracias por los buenos comentarios, ahora en base a tu consulta; Si es posible escribir un script con tus necesidades.

Una pregunta sobre tu consulta, los correos los almacenas en una carpeta en disco (Ejemplo mis documentos) o en una carpeta fuera del mailbox pero dentro del mismo correo o carpeta personal?
También es fundamental conocer que configuración utilizan para configurar sus correos IMAP, POP o Exchange?

Por otro lado, esta modificación requiere un par de horas para ser elaborada el cual si se realiza pero como servicio; si te interesa obtener la cotización escríbeme en Contacto.

Excelente día

Responder

Fernando

La configuración de mi correo dice que es tipo Microsoft exchange.

1. Los correos los distribuyo, fuera del mailbox
2. Una regla pasa los correos entrantes apenas llegan a la bandeja de entrada del mailbox a la bandeja de entrada de mi pst personal
3. una vez leídos los clasifico en carpetas, dentro del mismo outlook, que estan mi pst personal
4. El pst personal está en mi disco duro, local.
5. Cada vez que abro mi outlook se carga también mi pst personal, junto con el principal propio de mi cuenta de correo.
6. El código que requiero recorrería cada vez carpetas y sub carpetas de mi pst personal, por el check que hay en el dialogo cuando uno ejecuta manualmente una regla

Responder

Buen dia Eduardo

Ya aclarando estos detalles, como te comente anteriormente esta es una modificación mayor al código publicado [Normalmente si se requiere menos de 1 hora se realiza gratuitamente la modificación] me autorizas a enviarte por correo electrónico la cotización y detalles del servicio?

Quedo en espera de tu confirmación.

Excelente dia.

Responder

Si Fernando
Ya lo envié a contacto.
Gracias

Responder

Si Fernando, ya lo envié a contacto.
Gracias

Responder

Buen dia Eduardo

Se ha enviado detalles por medio de correo electrónico, no dudes en responder cualquier observación que tengas al respecto.

Excelente dia.

Responder

Buenas tardes

leyendo tus publicaciones te felicito por compartir tu conocimiento y ayudar a la gente tengo una consulta ¿como hago una macros que me permite reenviar un correo dependiendo del correo recibido?

por favor puedes comentar la lineas de codigo

Gracias

Responder

Buen dia

Te refieres responde el correo o enviar a otros destinatarios?

Si es reenviar revisa el siguiente código, si ocupas agregar varios correos; en Outlook crea un grupo y sera el que agregues en el correo del script.
Outlook reenviar correo y agregar texto automaticamente

De lo contrario para responder revisa el siguiente código

Option Explicit
Sub ReplyMSG()
Dim olItem As Outlook.MailItem
Dim olReply As MailItem \' Reply

For Each olItem In Application.ActiveExplorer.Selection
Set olReply = olItem.ReplyAll
olReply.HTMLBody = \"Gracias. \" & vbCrLf & olReply.HTMLBody
olReply.Display

\'olReply.Send
Next olItem
End Sub

Excelente dia

Responder

Hola Fernando. Me permito preguntar si es posible una macro para enviar mail con URL de imágenes ,jpg de rayos X a un folder determinado. Y otra macro para importar las URL de imágenes .jpg a una hoja excel con el nombre del paciente al que se le ha practicado el examen. Muchas gracias.

Responder

Buen dia Jose

Se puede descargar automáticamente los archivos que se encuentren en una URL siempre y cuando no se requiera accion de usuario tal como ingresar Captcha o similar.
Me puedes dar mas detalles de lo primero que me consultas?

Quedo en espera de detalles.

Excelente dia.

Responder

Gracias, Fernando, por tu oportuna y amable respuesta.

1. En el servicio de emergencias, utilizando el formulario excel del expediente clínico, el médico envía vía outlook una solicitud de radiografía al servicio de imagenología, con la identidad del paciente (abajo macro 1)
2. El servio de imagenología del establecimiento debe responder vía outlook con la imagen .jpg (o URL) de la radiografía y la identidad del paciente.
3. En el servicio de emergencias, otra macro incorpora en las celdas definidas la imagen .jpg que correspondan a cada solicitud.
4, Al cambiar el contenido de la celda de resultados otra macro coloca en una celda visible un hipervínculo para abrir la imagen. (abajo macro 2) La macro 2 debe reformularse, de acuerdo al contenido de las 2 macros que faltan.

Saludos.

Sub Imagen_1()
Application.ScreenUpdating = False
ActiveSheet.Unprotect

\'VER TODO
Columns(\"AJ:AJ\").Select
Selection.AutoFilter
ActiveSheet.Range(\"$AJ$1:$AJ$626\").AutoFilter Field:=1, Criteria1:=\"\"

If MsgBox(\"Acepta enviar a Imagenología esta solicitud 1...?\", vbQuestion + vbYesNo) vbYes Then
Exit Sub
End If
MsgBox \"Se marcará como \'enviada\' en el grupo 1\"

Dim i, j As Integer
Dim pagina1 As Worksheet

Set pagina1 = ActiveSheet
Dim OutApp As Object
Dim correo As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
\'Comprueba si Outlook esta abierto.Si no está lo abre
On Error Resume Next
Set OutApp = GetObject(\"\", \"Outlook.Application\")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject(\"Outlook.Application\")
OutApp.Visible = True
Set correo = OutApp.CreateItem(0)
\'Crea el correo y muestra
With correo
.To = pagina1.Range(\"Y72\").Value
.CC = pagina1.Range(\"Y73\").Value
.Subject = pagina1.Range(\"E2\").Value
.HTMLBody = pagina1.Range(\"V84\").Value
.Display
End With

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
ActiveSheet.Unprotect
Range(\"C92:D92\").Select
Selection.UnMerge
ActiveSheet.Unprotect
Range(\"U84\").Select
Selection.Copy
Range(\"C92\").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Unprotect
Range(\"C92:D92\").Select
Selection.Merge
ActiveSheet.Unprotect
Range(\"C93\").Select
ActiveCell.FormulaR1C1 = \"enviada 1\"

Range(\"C92\").Select

ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub

Sub Ima_jpg_1()

Range(\"D93\").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
\"..RXx-ray-223836__340.jpg\", TextToDisplay:=\"Ima_1\"
ActiveSheet.Unprotect
Range(\"D93\").Select
With Selection.Font
.Size = 7
End With
Range(\"D93\").Select
Selection.Font.Bold = True
ActiveSheet.Protect
End Sub

Responder

Gracias, Fernando por tu amable y oportuna respuesta.
El Programa SIEM (Sistema de Información de Emergencias Médicas) es un formulario de Historia Clínica programado en excel. La sección 5 es “Imagenología”.
1. Para solicitar un estudio radiográfico el médico llena el pedido con la identificación del paciente y lo envía por outlook al servicio de rayos X al seleccionar una opción de envío, en una lista desplegable.
2. El servicio de rayos X envía un mail outlook con la imagen .jpg (o un URL) de la radiografía del paciente al servicio de emergencias.
3. En celdas definidas del formulario del paciente se pegan las URL de las imágenes .jpg
4. Mediante hipervínculos que aparecen en la sección de resultados el médico puede visualizar las imágenes de las radiografías.(macro4)

Adjunto las macros 1 y 4. Faltan los scripts de las macros intermedias
Puedes visualizar un tutorial del programa en YouTube buscando “SIEM4”.

Saludos.

Macro 1:

Sub Imagen_1()
Application.ScreenUpdating = False
ActiveSheet.Unprotect

\'VER TODO
Columns(\"AJ:AJ\").Select
Selection.AutoFilter
ActiveSheet.Range(\"$AJ$1:$AJ$626\").AutoFilter Field:=1, Criteria1:=\"\"

If MsgBox(\"Acepta enviar a Imagenología esta solicitud 1...?\", vbQuestion + vbYesNo) vbYes Then
Exit Sub
End If
MsgBox \"Se marcará como \'enviada\' en el grupo 1\"

Dim i, j As Integer
Dim pagina1 As Worksheet

Set pagina1 = ActiveSheet
Dim OutApp As Object
Dim correo As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
\'Comprueba si Outlook esta abierto.Si no está lo abre
On Error Resume Next
Set OutApp = GetObject(\"\", \"Outlook.Application\")
Err.Clear
If OutApp Is Nothing Then Set OutApp = CreateObject(\"Outlook.Application\")
OutApp.Visible = True
Set correo = OutApp.CreateItem(0)
\'Crea el correo y muestra
With correo
.To = pagina1.Range(\"Y72\").Value
.CC = pagina1.Range(\"Y73\").Value
.Subject = pagina1.Range(\"E2\").Value
.HTMLBody = pagina1.Range(\"V84\").Value
.Display
End With

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
ActiveSheet.Unprotect
Range(\"C92:D92\").Select
Selection.UnMerge
ActiveSheet.Unprotect
Range(\"U84\").Select
Selection.Copy
Range(\"C92\").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Unprotect
Range(\"C92:D92\").Select
Selection.Merge
ActiveSheet.Unprotect
Range(\"C93\").Select
ActiveCell.FormulaR1C1 = \"enviada 1\"

Range(\"C92\").Select

ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub

Macro 4:

Sub Ima_jpg_1()

Range(\"D93\").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
\"..RXx-ray-223836__340.jpg\", TextToDisplay:=\"Ima_1\"
ActiveSheet.Unprotect
Range(\"D93\").Select
With Selection.Font
.Size = 7
End With
Range(\"D93\").Select
Selection.Font.Bold = True
ActiveSheet.Protect
End Sub

Responder

Buen dia Jose

Entiendo que ya tienes desarrollado el sistema y lo unido que deseas agregar es exportar las imagines y no las URL a las imágenes correcto?

Responder

Hola buenas tardes, primero muchas felicidades.
Quisiera solicitar de tu apoyo, necesito extraer los correos que contengan un asunto en específico, y si es posible indicar un rango de fecha para realizar la extracción

Saludos

Responder

Buen dia Joaquin

Si es posible, mas este script esta diseñado para ejecutarse por medio de una regla al momento de recibir un correo que cumpla las especificaciones.
Tengo un script premium (con costo) que voy a liberar al publico en un par de semanas (5 o 6) el cual se asemeja a lo que deseas, si quieres este cogido adecuado a tu necesidad me puedes escribir en contacto.

Por otro lado, por medio de una regla la puedes configurar para ejecutarse en los correos con asunto X y al final te permite aplicar a todo el Inbox despues de eso puedes filtrar en Excel los correos por fecha.

Excelente dia

Responder
Leer entrada anterior
Hostgator - Reseña, Calificación y Descuentos 2017
Hostgator – Reseña, Calificación y Descuentos 2017

Seleccionar un hosting adecuado para nuestro sitio web es una decisión importante ya que representa la calidad, velocidad de respuesta,...

Cerrar