Outlook 扫描特定文件夹并保存电子邮件中的所有附件 [英] Outlook scan specific folder and save all attachments from e-mails

问题描述

我有这个代码来保存 Outlook 中所选项目(邮件)的附件.

I have this code to save attachments for selected items(mails) from my Outlook.

我想设置特定文件夹(定义它)，Outlook 将自动扫描该文件夹中的所有电子邮件并保存附件.

I would like to set the specific folder (define it) and Outlook will automatically scan all e-mails in that folder and save attachments.

任何想法我应该如何扩展此代码以这种方式工作?

Any ideas how should I expand this code to work that way?

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

推荐答案

Replace your objSelection with Dim SubFolder As Outlook.MAPIFolder 然后使用对于 SubFolder.Items 中的每个 objMsg

Replace your objSelection with Dim SubFolder As Outlook.MAPIFolder then use For Each objMsg In SubFolder.Items

如果您从 Outlook 运行代码，也不需要创建 Outlook 对象 CreateObject("Outlook.Application")

also you don't need to create Outlook object if your running your code from Outlook CreateObject("Outlook.Application")

确保更新您的文件夹名称

Make sure to update your folder name

Set SubFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("文件夹名称")

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 运行它.

---

To Run it from 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

这篇关于Outlook 扫描特定文件夹并保存电子邮件中的所有附件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！