Excel Outlook VBA Salve emails não lidos em uma pasta de rede

Question

Consegui criar um script VBA do Outlook no Excel que salvaria apenas os anexos de mensagens "Não lidas" em uma subpasta específica do Outlook em uma pasta da minha rede e marcaria a mensagem como "Lida".

Estou tentando salvar os e-mails também. Eu tenho tido problemas ao tentar salvar a mensagem do Outlook na minha rede. O mais próximo que consegui foi adicionar o código em negrito abaixo. Embora eu não esteja recebendo a saída desejada.

Como em, os anexos estão sendo salvos na pasta H: \ Testing \ XY \ e eu gostaria de salvar as mensagens do Outlook na pasta H: \ Testing \ XY \ Emails. deseja que os emails sejam salvos com o nome do assunto e a data em que o email foi recebido.Quando executo o código VBA, os emails estão sendo salvos na pasta, H: \ Testing \ XY \, e os nomes dos arquivos são Emails .msg.

Os anexos estão salvando como eu gostaria que eles fossem embora. Qualquer ajuda para completar isso seria muito apreciada.

Sub SaveEmailAndAttach()

Dim myOlapp As Outlook.Application
Dim myNamespace As Outlook.Namespace
Dim myFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim myMail As Outlook.MailItem
Dim avDate() As String
Dim vDate As String
Dim i As Long
Dim myEmailPath As String

ReDim Preserve avDate(3)

Set myOlapp = CreateObject("Outlook.Application")
Set myNamespace = myOlapp.GetNamespace("MAPI")

Const myAttachPath As String = "H:\Testing\XY\"
**myEmailPath = enviro & "H:\Testing\XY\Emails"**

Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox).Folders("Auto").Folders("Manual")
For Each myItem In myFolder.Items
    If myItem.UnRead = True Then
        avDate = Split(CStr(myItem.ReceivedTime), "/")
        vDate = avDate(0) & "-" & avDate(1) & "-" & Mid(avDate(2), 1, 4)

        If myItem.Attachments.Count <> 0 Then
            For Each myAttachment In myItem.Attachments

            If UCase(Right(myAttachment.Filename, 4)) = "XLSX" Then
                i = i + 1
                myAttachment.SaveAsFile (myAttachPath & vDate & " " & myAttachment.Filename)

                End If
                Next
                **myItem.SaveAs myEmailPath & " " & vDate & ".msg"**
                myItem.UnRead = False
        End If
    End If
Next
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub

    

Answer 1

Você estava perto (-ish). O principal problema é a falta do \ de myEmailPath . Adicionando isso (e removendo o enviro & estranho) leva a esta declaração:

Const myEmailPath = "H:\Testing\XY\Emails\"

Seu código para salvar o email agora deve funcionar como está. No entanto, tomei a liberdade de estendê-lo para incluir também o assunto conforme sua exigência:

myItem.SaveAs myEmailPath & vDate & " " & myItem.Subject & ".msg"

No entanto, como o assunto pode conter caracteres que são proibidos em um nome de arquivo, seria melhor remover esses caracteres. O código a seguir fará exatamente isso (para o Windows):

'v0.1.1
Dim strSubject As String: strSubject = myItem.Subject
Dim varForbiddenChar
For Each varForbiddenChar In Split("\ / : * ? "" < > |")
  strSubject = Replace(strSubject, varForbiddenChar, "-")
Next varForbiddenChar

É claro que o código de decapagem de caracteres precisa ser inserido logo antes do código para salvar o e-mail, e o código precisa ser modificado da seguinte forma:

myItem.SaveAs myEmailPath & vDate & " " & strSubject & ".msg"