添付ファイルとして他の電子メールの中にあったOutlook電子メールから添付ファイル（Excelファイル）を保存するVBAコード

Question

添付ファイルを特定のOutlookフォルダにメッセージとして保存するコードがあります。

電子メールに添付ファイルがある場合、スクリプトは動作しますが、電子メールが添付ファイルと添付ファイルとして送信された場合は動作しません。

この場合、私の電子メールには、（自動転送ルールの）添付ファイルとして他の電子メールが含まれています。埋め込まれた電子メールの添付ファイルには、Excelファイルが含まれています。

私の現在のvba以下を参照してください：

Public Sub SaveOlAttachments() 
    Dim isAttachment As Boolean 
    Dim olFolder As Outlook.MAPIFolder 
    Dim msg As Outlook.MailItem 
    Dim att As Outlook.Attachment 
    Dim fsSaveFolder, sSavePathFS, ssender As String 

    On Error GoTo crash 

    fsSaveFolder = "C:\Documents and Settings\user\Desktop\" 
    isAttachment = False 
    Set olFolder = Outlook.GetNamespace("MAPI").Folders("...email server...") 
    Set olFolder = olFolder.Folders("Inbox") 
    If olFolder Is Nothing Then Exit Sub 

    For Each msg In olFolder.Items 
    If UCase(msg.Subject) = "TEST EMAIL WITH ATTACHMENT" Then 
        If msg.Attachments.Count > 0 Then 
      While msg.Attachments.Count > 0 
       sSavePathFS = fsSaveFolder & msg.Attachments(1).Filename 
      msg.Attachments(1).SaveAsFile sSavePathFS 
      msg.Attachments(1).Delete 
      isAttachment = True 
      Wend 
      msg.Delete 
     End If 
    End If  
    Next 

crash: 
    If isAttachment = True Then Call findFiles(fsSaveFolder) 
End Sub 

すべてのヘルプははるかに高く評価されるだろう。

を（ファイル名がMSGで終わる場合）

Answer 1

コードが下記の添付ファイルが電子メールメッセージであるか否かを添付ファイルとして電子メールに

1. テストを動作するように、このアプローチを使用して添付ファイルがある場合メッセージは、"C:\temp\KillMe.msg"として保存されます。
2. CreateItemFromTemplateは、コードが添付ファイルは、それがあたりとして抽出されたメッセージでない場合fsSaveFolder
3. にattachmnetsを取り除くために、この一時的なメッセージを処理し、新しいメッセージ（MSG2）
4. として保存されたファイルにアクセスするために使用されますあなたの現在のコード私はあなたのolFolder構造、Windoes版を持っていませんでしとして、Outlook変数などは、私がテストするために私自身のファイルパスとOutlookフォルダに追加しなければならなかったことを

注意。これらを変更する必要があります

Sub SaveOlAttachments() 

    Dim olFolder As Outlook.MAPIFolder 
    Dim msg As Outlook.MailItem 
    Dim msg2 As Outlook.MailItem 
    Dim att As Outlook.Attachment 
    Dim strFilePath As String 
    Dim strTmpMsg As String 
    Dim fsSaveFolder As String 

    fsSaveFolder = "C:\test\" 

    'path for creating attachment msg file for stripping 
    strFilePath = "C:\temp\" 
    strTmpMsg = "KillMe.msg" 

    'My testing done in Outlok using a "temp" folder underneath Inbox 
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 
    Set olFolder = olFolder.Folders("Temp") 
    If olFolder Is Nothing Then Exit Sub 

    For Each msg In olFolder.Items 
     If msg.Attachments.Count > 0 Then 
     While msg.Attachments.Count > 0 
     bflag = False 
      If Right$(msg.Attachments(1).FileName, 3) = "msg" Then 
       bflag = True 
       msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg 
       Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg) 
      End If 
      If bflag Then 
       sSavePathFS = fsSaveFolder & msg2.Attachments(1).FileName 
       msg2.Attachments(1).SaveAsFile sSavePathFS 
       msg2.Delete 
      Else 
       sSavePathFS = fsSaveFolder & msg.Attachments(1).FileName 
       msg.Attachments(1).SaveAsFile sSavePathFS 
      End If 
      msg.Attachments(1).Delete 
      Wend 
      msg.Delete 
     End If 
    Next 
    End Sub