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