Guardar adjuntos de correo electrónico entrante con un asunto específico.
En Outlook 365, no se permiten reglas ni scripts ya que no soy administrador completo en la máquina.
Necesito verificar cuando llega un correo,
si tiene algunas palabras específicas en el asunto,
luego guardar el adjunto en una carpeta específica (sería mejor con el nombre del asunto del correo + marca de fecha) y luego poner el correo en la papelera.
Intenté el siguiente código.
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
'--------------------- ok hasta aquí -----------
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Set objAttachments = Msg.Attachments
If TypeName(Item) = "MailItem" Then
If InStr(Msg.Subject, "Magic Red Carpet") Then
objAttachments.SaveAsFile "C:\Users\xx12345\Desktop\vba\" & objAttachments.Msg.Subject & date
End If
End If
ErrorHandler:
MsgBox "¡Ups!"
End Sub
davy.ai
Este código VBA intenta cumplir con los requisitos establecidos en la pregunta en Outlook 365. Sin embargo, hay algunos problemas con el código:
Msg
no se establece en elItem
pasado al controlador de eventosinboxItems_ItemAdd
. Por lo tanto, el código dará lugar a un error en tiempo de ejecución al intentar usarMsg
. Para solucionar esto, agregue el siguiente código al principio del subinboxItems_ItemAdd
:date
no está definida. Para solucionar esto, reemplace&date
por&Format(Now(), "yyyy-mm-dd")
.El código no mueve el correo electrónico a la papelera después de guardar el adjunto. Para solucionar esto, agregue el siguiente código después de guardar el adjunto:
Con estos cambios, el código VBA actualizado se vería así: