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