excel - una - seleccionar varios adjuntos outlook 2016

Descargar archivo adjunto de Outlook y abrir en Excel

Question

Intento descargar y luego abrir una hoja de cálculo de Excel adjunta en un correo electrónico de Outlook usando VBA en Excel. Cómo puedo:

1. Descargue el único archivo adjunto del primer correo electrónico (el último) en mi bandeja de entrada de Outlook
2. Guarde el archivo adjunto en un archivo con una ruta especificada (por ejemplo: "C: ...")
3. Cambie el nombre del archivo adjunto con: fecha actual + nombre de archivo anterior
4. Guarde el correo electrónico en una carpeta diferente con una ruta como "C: ..."
5. Marque el correo electrónico en Outlook como "leer"
6. Abra el archivo adjunto Excel en Excel

También quiero poder guardar lo siguiente como cadenas individuales asignadas a variables individuales:

• Dirección de correo electrónico del remitente
• Fecha de recepción
• Fecha de envío
• Tema
• El mensaje del correo electrónico

aunque puede ser mejor preguntar en una pregunta separada / buscarlo yo mismo.

El código que tengo actualmente es de otros foros en línea, y probablemente no sea muy útil. Sin embargo, aquí hay algunas partes en las que he estado trabajando:

Sub SaveAttachments()
    Dim olFolder As Outlook.MAPIFolder
    Dim att As Outlook.Attachment
    Dim strFilePath As String
    Dim fsSaveFolder As String

    fsSaveFolder = "C:/test/"

    strFilePath = "C:/temp/"

    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

    For Each msg In olFolder.Items
        While msg.Attachments.Count > 0
            bflag = False
            If Right$(msg.Attachments(1).Filename, 3) = "msg" Then
                bflag = True
                msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg
                Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)
            End If
            sSavePathFS = fsSaveFolder & msg2.Attachments(1).Filename


    End If
End Sub

Answer 1

Puedo darte el código completo de una vez, pero eso no te ayudaría a aprender de él;) Así que vamos a desglosar tus solicitudes y luego las abordaremos de 1 en 1. Esta será una publicación muy larga, así que ten paciencia: )

Hay un total de 5 partes que cubrirán los 7 puntos (sí 7 y no 6) para que no tenga que crear una nueva pregunta para su 7mo punto.

PARTE 1

1. Crear una conexión a Outlook
2. Verificando si hay algún correo electrónico no leído
3. Recuperando detalles como la Sender email Address , la Date received , la Date Sent , el Subject , The message of the email

Vea este ejemplo de código. Estoy vinculados con Outlook desde Excel y luego comprobé si hay elementos no leídos y, si los estoy recuperando, los detalles relevantes.

Const olFolderInbox As Integer = 6

Sub ExtractFirstUnreadEmailDetails()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object

    ''~~> Outlook Variables for email
    Dim eSender As String, dtRecvd As String, dtSent As String
    Dim sSubj As String, sMsg As String

    ''~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    ''~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    ''~~> Store the relevant info in the variables
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        eSender = oOlItm.SenderEmailAddress
        dtRecvd = oOlItm.ReceivedTime
        dtSent = oOlItm.CreationTime
        sSubj = oOlItm.Subject
        sMsg = oOlItm.Body
        Exit For
    Next

    Debug.Print eSender
    Debug.Print dtRecvd
    Debug.Print dtSent
    Debug.Print sSubj
    Debug.Print sMsg
End Sub

Para que se encargue de su solicitud que habla de almacenar detalles en las variables.

PARTE 2

Ahora pasar a su próxima solicitud

1. Descargue el único archivo adjunto del primer correo electrónico (el último) en mi bandeja de entrada de Outlook
2. Guarde el archivo adjunto en un archivo con una ruta especificada (por ejemplo: "C: ...")
3. Cambie el nombre del archivo adjunto con: fecha actual + nombre de archivo anterior

Vea este ejemplo de código. Nuevamente estoy vinculando Outlook con Excel y comprobando si hay elementos no leídos y, si los hay, estoy verificando si tiene un archivo adjunto y si lo tiene, descárguelo a la carpeta correspondiente.

Const olFolderInbox As Integer = 6
''~~> Path for the attachment
Const AttachmentPath As String = "C:/"

Sub DownloadAttachmentFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    ''~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"

    ''~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    ''~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    ''~~> Extract the attachment from the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        ''~~> Check if the email actually has an attachment
        If oOlItm.Attachments.Count <> 0 Then
            For Each oOlAtch In oOlItm.Attachments
                ''~~> Download the attachment
                oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
                Exit For
            Next
        Else
            MsgBox "The First item doesn''t have an attachment"
        End If
        Exit For
    Next
 End Sub

PARTE - 3

Pasando a su próxima solicitud

1. Guarde el correo electrónico en una carpeta diferente con una ruta como "C: ..."

Vea este ejemplo de código. Esto guarda el correo electrónico para decir C: /

Const olFolderInbox As Integer = 6
''~~> Path + Filename of the email for saving
Const sEmail As String = "C:/ExportedEmail.msg"

Sub SaveFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    ''~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    ''~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    ''~~> Save the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.SaveAs sEmail, 3
        Exit For
    Next
End Sub

PARTE - 4

Pasando a su próxima solicitud

1. Marque el correo electrónico en Outlook como "leer"

Vea este ejemplo de código. Esto marcará el correo electrónico como read .

Const olFolderInbox As Integer = 6

Sub MarkAsUnread()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    ''~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    ''~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    ''~~> Mark 1st unread email as read
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.UnRead = False
        DoEvents
        oOlItm.Save
        Exit For
    Next
 End Sub

PARTE - 5

Pasando a su próxima solicitud

1. Abra el archivo adjunto excel en excel

una vez que haya descargado el archivo / archivo adjunto como se muestra arriba, entonces use esa ruta en el siguiente código para abrir el archivo.

Sub OpenExcelFile()
    Dim wb As Workbook

    ''~~> FilePath is the file that we earlier downloaded
    Set wb = Workbooks.Open(FilePath)
End Sub

Answer 2

(Excel vba)

Gracias a Sid :) por su código (robado su código) .. tuve esta situación hoy. Aquí está mi código. Código inferior guarda el adjunto, correo también información de correo. Todos los créditos van a Sid.

Tested 

Sub mytry()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String

Const num As Integer = 6
Const path As String = "C:/HP/"
Const emailpath As String = "C:/Dell/"
Const olFolderInbox As Integer = 6

Set olp = CreateObject("outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)

If olmail.items.restrict("[UNREAD]=True").Count = 0 Then

    MsgBox ("No Unread mails")

    Else

        For Each olitem In olmail.items.restrict("[UNREAD]=True")
            lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

            Range("A" & lrow).Value = olitem.Subject
            Range("B" & lrow).Value = olitem.senderemailaddress
            Range("C" & lrow).Value = olitem.to
            Range("D" & lrow).Value = olitem.cc
            Range("E" & lrow).Value = olitem.body

            If olitem.attachments.Count <> 0 Then

                For Each olattach In olitem.attachments

                    olattach.SaveAsFile path & Format(Date, "MM-dd-yyyy") & olattach.Filename

                Next olattach

            End If
    str = olitem.Subject
    str = Replace(str, "/", "-")
    str = Replace(str, "|", "_")
    Debug.Print str
            olitem.SaveAs (emailpath & str & ".msg")
            olitem.unread = False
            DoEvents
            olitem.Save
        Next olitem

End If

ActiveSheet.Rows.WrapText = False

End Sub