es.davy.ai

Preguntas y respuestas de programación confiables

¿Tienes una pregunta?

Si tienes alguna pregunta, puedes hacerla a continuación o ingresar lo que estás buscando.

Guardar adjuntos de correo electrónico entrante con un asunto específico.

23 Jul, 2023 Programación

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
Tags:  , ,

Answer

  1. Avatar for davy.ai
    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:

    1. El objeto Msg no se establece en el Item pasado al controlador de eventos inboxItems_ItemAdd. Por lo tanto, el código dará lugar a un error en tiempo de ejecución al intentar usar Msg. Para solucionar esto, agregue el siguiente código al principio del sub inboxItems_ItemAdd:
    Set Msg = Item
    1. La variable date no está definida. Para solucionar esto, reemplace &date por &Format(Now(), "yyyy-mm-dd").

    2. 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:

    Item.Delete
    1. El código no maneja casos en los que el correo electrónico tiene varios adjuntos. Para solucionar esto, recorra todos los adjuntos y guarde cada uno por separado:
    For Each attachment In objAttachments
    attachment.SaveAsFile "C:\Users\xx12345\Desktop\vba\" & Msg.Subject & "_" & Format(Now(), "yyyy-mm-dd") & "_" & attachment.FileName
Next attachment

    Con estos cambios, el código VBA actualizado se vería así:

    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

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler

Dim Msg As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Set objAttachments = objItem.Attachments

If TypeName(Item) = "MailItem" Then
    Set Msg = Item
    If InStr(Msg.Subject, "Magic Red Carpet") Then
        For Each attachment In objAttachments
            attachment.SaveAsFile "C:\Users\xx12345\Desktop\vba\" & Msg.Subject & "_" & Format(Now(), "yyyy-mm-dd") & "_" & attachment.FileName
        Next attachment
        Item.Delete
    End If
End If

ErrorHandler:
    MsgBox "¡Ay!"

End Sub

Comments are closed.