Outlookは特定のフォルダをスキャンし、電子メールからすべての添付ファイルを保存します

Question

私はこのコードを使用して、Outlookから選択したアイテム（メール）の添付ファイルを保存します。

特定のフォルダ（定義する）を設定したいと思います。Outlookはそのフォルダ内のすべての電子メールを自動的にスキャンして添付ファイルを保存します。

このコードをどのように展開してそのようにする必要がありますか？

Public Sub SaveAttachments() 

Dim objOL As Outlook.Application 
Dim objMsg As Outlook.MailItem 
Dim objAttachments As Outlook.Attachments 
Dim objItems As Outlook.Items 
Dim objSelection As Outlook.Selection 
Dim i As Long 
Dim lngCount As Long 
Dim strFile As String 
Dim strFolderpath As String 
Dim strDeletedFiles As String 

strFolderpath = "C:\Users\gpyko\Desktop\Pentaho project\HDPS RAPORTY" 
Set objOL = CreateObject("Outlook.Application") 
Set objSelection = objOL.ActiveExplorer.Selection 
strFolderpath = strFolderpath & "\Attachments\" 

For Each objMsg In objSelection 

    Set objAttachments = objMsg.Attachments 
    lngCount = objAttachments.Count 
    strDeletedFiles = "" 

    If lngCount > 0 Then 

    For i = lngCount To 1 Step -1 

     strFile = objAttachments.Item(i).FileName 
     strFile = strFolderpath & strFile 
     objAttachments.Item(i).SaveAsFile strFile 
     objAttachments.Item(i).Delete 

     If objMsg.BodyFormat <> olFormatHTML Then 

      strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
     Else 
      strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
      strFile & "'>" & strFile & "</a>" 
     End If 

    Next i 

     If objMsg.BodyFormat <> olFormatHTML Then 

      objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body 
     Else 
      objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody 
     End If 
     objMsg.Save 

    End If 

Next 

ExitSub: 
Set objAttachments = Nothing 
Set objMsg = Nothing 
Set objSelection = Nothing 
Set objOL = Nothing 
End Sub 

Answer 1

フォルダ名を更新することを確認してくださいあなたは、Outlook CreateObject("Outlook.Application")

からあなたのコードを実行している場合にも、あなたがOutlookオブジェクトを作成する必要はありません For Each objMsg In SubFolder.Items

を使用し、その後Dim SubFolder As Outlook.MAPIFolderであなたのobjSelectionを置き換え

Set SubFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("Folder Name")

Option Explicit 
Public Sub SaveAttachments() 
    Dim olNs As Outlook.NameSpace 
    Dim objMsg As Outlook.MailItem 
    Dim objAttachments As Outlook.Attachments 
    Dim objItems As Outlook.Items 
    Dim SubFolder As Outlook.MAPIFolder 
    Dim i As Long 
    Dim lngCount As Long 
    Dim strFile As String 
    Dim strFolderpath As String 
    Dim strDeletedFiles As String 

    strFolderpath = "C:\Users\gpyko\Desktop\Pentaho project\HDPS RAPORTY" 

    Set olNs = Application.GetNamespace("MAPI") 

    Set SubFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("Folder Name") 

    strFolderpath = strFolderpath & "\Attachments\" 


    For Each objMsg In SubFolder.Items 
     Set objAttachments = objMsg.Attachments 
     lngCount = objAttachments.Count 
     strDeletedFiles = "" 

     If lngCount > 0 Then 

      For i = lngCount To 1 Step -1 

      strFile = objAttachments.Item(i).FileName 
      strFile = strFolderpath & strFile 
      objAttachments.Item(i).SaveAsFile strFile 
      objAttachments.Item(i).Delete 

      If objMsg.BodyFormat <> olFormatHTML Then 

       strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
      Else 
       strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
       strFile & "'>" & strFile & "</a>" 
      End If 

      Next i 

      If objMsg.BodyFormat <> olFormatHTML Then 

       objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body 
      Else 
       objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody 
      End If 

      objMsg.Save 

     End If 
    Next 


ExitSub: 
    Set objAttachments = Nothing 
    Set objMsg = Nothing 
    Set SubFolder = Nothing 
    Set olNs = Nothing 
End Sub 

---

実行するにはExcelから実行します。

Option Explicit 
Public Sub SaveAttachments() 
    Dim App As Outlook.Application 
    Dim olNs As Outlook.Namespace 
    Dim objMsg As Outlook.MailItem 
    Dim objAttachments As Outlook.Attachments 
    Dim objItems As Outlook.Items 
    Dim SubFolder As Outlook.MAPIFolder 
    Dim i As Long 
    Dim lngCount As Long 
    Dim strFile As String 
    Dim strFolderpath As String 
    Dim strDeletedFiles As String 

    strFolderpath = "C:\Users\gpyko\Desktop\Pentaho project\HDPS RAPORTY" 
    Set App = New Outlook.Application 
    Set olNs = App.GetNamespace("MAPI") 

    Set SubFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("Folder Name") 

    strFolderpath = strFolderpath & "\Attachments\" 


    For Each objMsg In SubFolder.Items 
     Set objAttachments = objMsg.Attachments 
     lngCount = objAttachments.Count 
     strDeletedFiles = "" 

     If lngCount > 0 Then 

      For i = lngCount To 1 Step -1 

      strFile = objAttachments.Item(i).Filename 
      strFile = strFolderpath & strFile 
      objAttachments.Item(i).SaveAsFile strFile 
      objAttachments.Item(i).Delete 

      If objMsg.BodyFormat <> olFormatHTML Then 

       strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">" 
      Else 
       strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _ 
       strFile & "'>" & strFile & "</a>" 
      End If 

      Next i 

      If objMsg.BodyFormat <> olFormatHTML Then 

       objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body 
      Else 
       objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody 
      End If 

      objMsg.Save 

     End If 
    Next 

ExitSub: 
    Set objAttachments = Nothing 
    Set objMsg = Nothing 
    Set SubFolder = Nothing 
    Set olNs = Nothing 
End Sub