Excel Outlook VBA Сохранить непрочитанные письма в сетевой папке

Question

Мне удалось создать сценарий Outlook VBA в Excel, который бы сохранял только вложения "непрочитанных" сообщений в определенной подпапке Outlook в папку в моей сети, а затем помечал сообщение как "Чтение".

Я тоже пытаюсь сохранить электронные письма. У меня возникли проблемы при попытке сохранить сообщение Outlook в моей сети. Самым близким, что я смог получить, было добавление кода, выделенного жирным шрифтом ниже. Хотя я не получаю желаемый результат.

Например, вложения сохраняются в папке H:\Testing\XY\, и я хочу сохранить сообщения Outlook в папке H:\Testing\XY\Emails ". Между тем, я просто хочу сохранить электронные письма с именем субъекта и датой получения электронного письма. Когда я запускаю код VBA, электронные письма сохраняются в папке H:\Testing\XY\, а имена файлов - Emails.msg.

Вложения сохраняются так, как мне бы хотелось. Любая помощь для завершения этого будет принята с благодарностью.

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

Вы были близки (-и). Основная проблема - отсутствующий трейлинг \ из myEmailPath . Добавление этого (и удаление постороннего enviro &) приводит к этому объявлению:

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

Ваш код для сохранения электронной почты теперь должен работать, как есть. Тем не менее, я взял на себя смелость расширить его, чтобы также включить тему согласно вашему требованию:

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

Однако, поскольку субъект может содержать символы, которые запрещены в имени файла, было бы лучше удалить эти символы. Следующий код сделает это (для Windows):

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

Конечно, код для удаления символов должен быть вставлен непосредственно перед кодом для сохранения электронного письма, и этот код необходимо изменить следующим образом:

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