Outlook은 특정 폴더를 스캔하고 이메일의 모든 첨부 파일을 저장합니다.

objSelection을 Dim SubFolder As Outlook.MAPIFolder다음으로 바꾸십시오.For Each objMsg In SubFolder.Items

또한 Outlook에서 코드를 실행하는 경우 Outlook 개체를 만들 필요가 없습니다. CreateObject("Outlook.Application")

폴더 이름을 업데이트하십시오.

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