web-dev-qa-db-ja.com

Excel OutlookVBA未読メールをネットワークフォルダに保存

ExcelでOutlookVBAスクリプトを作成して、特定の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
microsoft-excelmicrosoft-outlookvba
3
DrewDaddio

あなたは近かった（-ish）。主な問題は、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

もちろん、メールを保存するには、コードの直前に文字ストリッピングコードを挿入する必要があり、thatコードを次のように変更する必要があります。

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