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

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

Também estou tentando salvar os e-mails. Estou com problemas para salvar a mensagem do Outlook na minha rede. O mais próximo que pude chegar foi adicionando o código em negrito abaixo. Embora eu não esteja obtendo a saída desejada.

Assim, 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 ". Enquanto isso, só quero os emails para serem salvos com o nome do assunto e a data em que o email foi recebido.No entanto, 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 gostaria. Qualquer ajuda para concluir 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

Você estava perto (-ish). O principal problema é a fuga em falta \a partir myEmailPath. Adicionar isso (e remover o estranho enviro &) 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 proibidos em um nome de arquivo, seria melhor remover esses caracteres. O código a seguir fará exatamente isso (para Windows):

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

Obviamente, o código de remoção de caracteres precisa ser inserido imediatamente antes do código para salvar o email, e esse código precisa ser modificado da seguinte maneira:

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