vba - office - como guardar un correo electronico en mis documentos

Cómo guardar un correo electrónico enviado no único a la carpeta de Windows

Question

Tengo un código VBA cuyas principales funciones son:

1. Cargar un formulario
2. Permitir que un usuario elija una respuesta de stock de correo electrónico
3. Abra un documento de Word con el texto de respuesta completo
4. Crea una respuesta usando el texto
5. Busque en el correo electrónico y cree una colección de cadenas que contengan números de archivos corporativos
6. Agregue los números de archivo a una lista de Excel
7. Envía la respuesta

Ahora quiero guardar una copia del artículo enviado en una carpeta de Windows, para cada número de archivo. He estado tratando de esperar hasta que se envíe el elemento y se mueva a Elementos enviados. El problema es que después de llamar al método de envío, el elemento de correo no envía ni se mueve a Elementos enviados hasta que el código finaliza, por lo que termino en un ciclo infinito.

Todas las opciones que encontré implican el uso de un módulo de clase y WithEvents. Eso funcionaría si quisiera copiar cada elemento enviado a la carpeta. No puedo pensar en ningún criterio que diferencie los correos electrónicos creados por esta macro de los correos electrónicos normales. Podría entrar en la lista de archivos de Excel, pero eso empantanaría la máquina de todos en cada envío.

¿Hay alguna manera de simplemente hacer que el correo electrónico se entere cuando se envió y se trasladó a los artículos enviados? Mi código para enviar, esperar que vaya a los artículos enviados y guardar los correos electrónicos está a continuación. Tenga en cuenta que tengo dos variables globales: cReply (Outlook.MailItem - la respuesta) y fNums (Colección - los números de archivo).

Estoy codificando en Outlook 2016, pero espero mover el módulo a Outlook 2010 en el trabajo.

Sub Send()
    Dim badChar As String
    badChar = "//:*?™""® <>|.&@#_+`©~;-+=^$!,''" & Chr(34)
    Dim x As Integer
    Dim fName As String
    Dim inSentItems As Boolean
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim olFldr As Outlook.MAPIFolder
    Dim cSent As Outlook.MailItem
    Dim sentMoment As Date
    fName = cReply.Subject
    For x = 1 To Len(badChar)
        fName = Replace(fName, Mid(badChar, x, 1), "-")
    Next x
    Set olApp = GetObject(, "Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFldr = olNS.GetDefaultFolder(olFolderSentMail)
    inSentItems = True
    x = olFldr.Items.Count
    sentMoment = Now
    cReply.Send
    Do While olFldr.Items.Count <> x + 1
        If Now - sentMoment > TimeValue("0:00:10") Then
            inSentItems = False
            Exit Do
        End If
        DoEvents
    Loop
    If inSentItems Then
        Set cSent = olFldr.Items(olFldr.Items.Count)
        For x = 1 To fNums.Count
            cSent.SaveAs sentFldrPth & fNums.Item(x) & " - " & fName & ".msg", olMSG
        Next x
        ''cSent.Delete
    End If
    Set olApp = Nothing
    Set olNS = Nothing
    Set olFldr = Nothing
End Sub

Answer 1

Puede usar SaveSentMessageFolder para guardar en otra carpeta.

https://msdn.microsoft.com/en-us/library/office/ff868473.aspx

Controle esta otra carpeta con el código ItemAdd. Puede mover el correo a la carpeta Elementos enviados una vez hecho.