** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Recibir correos e inyectarlos en una tabla
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoRecibir correos e inyectarlos en una tabla

 Responder Responder
Autor
Mensaje
01loko Ver desplegable
Asiduo
Asiduo


Unido: 17/Agosto/2017
Localización: Santander
Estado: Sin conexión
Puntos: 463
Enlace directo a este mensaje Tema: Recibir correos e inyectarlos en una tabla
    Enviado: 07/Noviembre/2018 a las 21:26
La idea:
Recoger correos desde outlook (u otro gestor) que llegan a traves de una cuenta concreta y recopilar el asunto, la fecha de recepcion y el cuerpo (en texto plano siempre) y crear un registro en una tabla

las preguntas:
¿Se puede?
¿algun ejemplo de recoleccion de datos de esta manera?


Alguna idea?

Gracias de antemano


Recordar de que soy nuevo y estoy aprendiendo.
Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: Prisión Brieva
Estado: Sin conexión
Puntos: 3197
Enlace directo a este mensaje Enviado: 08/Noviembre/2018 a las 03:23
Justo hoy has tenido suerte, lo he hecho  esta semana :)

Esto es en Excel, pero seguro que es 3/4 de lo mismo en Access


Tienes que añadir la lreferencia Miscorsoft outlook 12.0 Object Library



Sub Test()

    Dim olApp As Outlook.Application
    Dim olNamSpa As Namespace
    Dim mapiFolder As mapiFolder
    Dim olMail As Variant
    Dim i As Integer
    
    Set olApp = New Outlook.Application
    Set olNamSpa = olApp.GetNamespace("MAPI")
    Set mapiFolder = olNamSpa.GetDefaultFolder(olFolderInbox) 'Aquí puedes cambiar a otras carpetas o PST esto lee solo "inbox" o "bandeja de entrada", depende el idioma
    
    i = 1
    Range("A" & i).Value = "Received"
    Range("B" & i).Value = "Sender"
    Range("C" & i).Value = "Sender email"
    Range("D" & i).Value = "Subject"
    Range("E" & i).Value = "Receiver"
    ' Añadir contenido (foro)
    Range("f" & i).Value = "contenido"
    
    For Each olMail In mapiFolder.Items

        Range("A" & i + 1).Value = olMail.ReceivedTime
        Range("B" & i + 1).Value = olMail.SenderName
        Range("C" & i + 1).Value = olMail.SenderEmailAddress
        Range("D" & i + 1).Value = olMail.Subject
        Range("E" & i + 1).Value = olMail.ReceivedByName
        If (olMail.Size < 1000) Then ' si es grande puede causar problemas, configurar a tamaño deeseado
         Range("f" & i + 1).Value = olMail.Body
        End If
        i = i + 1
        DoEvents
    Next olMail
    
    Set mapiFolder = Nothing
    Set olNamSpa = Nothing
    Set olApp = Nothing
    
   ' Format cols
    Range("A1:f1").Select 'Add body
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Size = 12
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 6299648
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True

    Columns("A:F").Select
    Columns("A:F").EntireColumn.AutoFit

    MsgBox "Done!"
End Sub

Those are my principles, and if you don't like them... well, I have others. Groucho Marx
Arriba
01loko Ver desplegable
Asiduo
Asiduo


Unido: 17/Agosto/2017
Localización: Santander
Estado: Sin conexión
Puntos: 463
Enlace directo a este mensaje Enviado: 14/Noviembre/2018 a las 11:29
gracias, me sirve, le modificare (dejando la autoria) y utilizare 


se puede cerrar el hilo
Recordar de que soy nuevo y estoy aprendiendo.
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable