[Outlook VBA] 메일함 첨부파일 일괄 다운로드 하기

안녕하세요.

 

업무용으로 아웃룩을 쓰고 계시는 분들 많으시죠. 일을 하다 보면 메일이 잔뜩 쌓이고, 또 여러 메일에 들어있는 여러 첨부 파일들을 다 다운받아야 할 때도 있습니다. 예전 같았으면 메일을 하나하나 열어서 다운받아야 했을텐데, 우리에게는 VBA가 있어서 한번에 다운받을 수가 있습니다.

 

 

아래 코드는 아웃룩에서 "계정이름" 아래에 있는 "폴더이름"의 모든 메일에 대하여

첨부파일을 확인하여 확장자가 pdf면 다운받아서 "C:\Temp\"에 저장하는 코드입니다.

 

이름이 중복되는 파일도 모두 받기 위하여 파일 이름 앞에 "YYYYMMDD_HHNN"을 추가하여 저장하도록 했습니다.

 

전체 코드

Sub SaveAttachments()
    Dim olApp           As Object
    Dim olNS            As Object
    Dim olFolder        As Object
    Dim olItems         As Object
    Dim olItem          As Object
    Dim olAtt           As Object
    Dim sSaveToFolder   As String
    Dim prefix          As String
    
    sSaveToFolder = "C:\Temp\"
    
    Set olApp = CreateObject("Outlook.Application")
    Set olFolder = olApp.GetNamespace("MAPI").Folders("계정이름").Folders("폴더이름")
    Set olItems = olFolder.Items
    
    For Each olItem In olItems
        If olItem.Attachments.Count > 0 Then
            prefix = Format(olItem.ReceivedTime, "YYYYMMDD_HHNN") & "_"
            For Each olAtt In olItem.Attachments
            
                If LCase(Right(olAtt.filename, 3)) = "pdf" Then
                    olAtt.SaveAsFile sSaveToFolder & prefix & olAtt.filename
                    olItem.Save
                End If

            Next olAtt
        End If
    Next olItem
    
    Set olApp = Nothing
    Set olNS = Nothing
    Set olFolder = Nothing
    Set olItems = Nothing
    Set olItem = Nothing
    Set olAtt = Nothing
    
End Sub

 

 

코드 설명

변수 선언하는 부분은 지우고, 필요시 수정해야 하는 부분만 말씀드리겠습니다.

 

sSaveToFolder = "C:\Temp\"

첨부 파일을 저장할 위치를 지정합니다.

 

Set olFolder = olApp.GetNamespace("MAPI").Folders("계정이름").Folders("폴더이름")

 

메일함에서 어떤 폴더의 첨부파일을 다운받을지 설정합니다. 아래의 스크린샷처럼, 아웃룩에서 이름을 확인하고 입력해야 합니다. 저 같은 경우에는 뒷분이 "GetNamespace("MAPI").Folders("min------@kakao.com").Folders("training")" 와 같이 되었습니다. 

 

    For Each olItem In olItems
        If olItem.Attachments.Count > 0 Then
            prefix = Format(olItem.ReceivedTime, "YYYYMMDD_HHNN") & "_"
            For Each olAtt In olItem.Attachments
                If LCase(Right(olAtt.filename, 3)) = "pdf" Then
                    olAtt.SaveAsFile sSaveToFolder & prefix & olAtt.filename
                    olItem.Save
                End If
            Next olAtt
        End If
    Next olItem

 

(코드 스니펫에 Visual Basic이 없어서 주석과 함께 설명하기가 곤란하네요)

 

한줄씩 말씀드리자면

 

 Line #1 : 메일함의 각각의 메일 아이템에 대하여

 Line #2: 첨부 파일의 개수가 0 이상이면

 Line #3 : 메일을 받은 시간을 YYYYMMDD_HHNN 형식으로 prefix라는 변수에 넣고

 Line #4 : 각각의 첨부 파일에 대하여

 Line #5 : 첨부 파일의 마지막 3글자가 pdf이면

 Line #6 : 다운받아서 저장하고 파일 이름 앞에 prefix를 붙인다.

 

상황에 맞게 코드 수정하셔서 사용하시면 됩니다.

 

Line #3에서 prefix를 넣은 이유는 앞에서 언급했듯 중복되는 이름의 파일을 모두 받기 위해서 그렇게 한 거구요

Line #5에서 pdf파일만 지정한 이유는 서명 등이 이미지로 되어 있어서 다운받는 파일이 너무 많아지는 바람에 일부러 pdf만 받으려고 설정한 것입니다. 해당 if문을 지우시면 모든 파일을 다 받으실 수 있겠지요..

 

 

실행하는 법

엑셀이나 워드와 마찬가지로 아웃룩에서 Alt+F11을 누르시면 VBA 창이 켜집니다. 아래 화면에서 모듈 우클릭하시고 새로운 모듈을 만든 후에 코드를 입력하여주세요. 코드 입력 후에 커서를 해당 함수 안에 두고(해당 코드) 4번의 실행 버튼을 누르시면 해당 코드가 실행이 됩니다.

 

VBA 화면

 

 

실행결과 예시

 

구글링한 것 일부 수정하여 사용중이라, 필요에 맞게 수정하여 사용해주세요.

Msgbox를 이용하여 실행 여부를 확인하는 것은 필요해 보입니다.

 

감사합니다.

 

 

참고

매크로 실행이 안 된다면 아래와 같이 보안 설정을 변경해주세요.