고정 헤더 영역
상세 컨텐츠
본문
(엑셀 VBA 예시)outlook 메일 일괄 다운로드.xlsm
0.14MB
오늘날 이메일을 사용하지 않는 사람을 찾기 어렵습니다. 하지만 대부분의 메일함에는 용량 제한이 있어 정기적으로 메일을 정리해야 합니다. 그렇지 않으면 메일함이 가득 차서 더이상 메일을 송수신할 수 없는 문제가 발생할 수 있습니다.
이에 대한 해결 방법으로 PC 하드디스크로 메일함의 메일을 일괄 백업하는 방법이 있으면 좋겠죠. 그러나 아쉽게도 Outlook에는 한번에 한 개 메일만 PC로 저장이 가능하도록 되어 있네요.
이런 문제 해결 방법으로 엑셀 VBA 프로그램을 사용하여 메일 일괄 다운로드 기능을 개발해 봤습니다. 메일 일괄 다운로드 프로그램 동영상을 먼저 보고 엑셀 VBA 매크로 프로그램 개발 과정을 설명해 드리겠습니다.
1. Outlook 메일 일괄 다운로드 엑셀 VBA 프로그램 시연
2. 엑셀 VBA를 이용한 Outlook 메일 일괄 다운로드 기능 구현 방법
1) 먼저 엑셀 VBA에서 Outlook을 제어하기 위한 개발 환경을 설정 합니다.
Microsoft Visual Basic for Applications 창을 열고 도구 메뉴에서 참조를 선택합니다. 참조 대화 상자에서 Microsoft Outlook 16.0 Object Library를 찾아 체크합니다.
2) "메일 일괄 다운로드" 버튼 클릭시 호출될 Sub 함수를 작성하기 위해 모듈을 생성 합니다.
아래 그림과 같이 삽입 메뉴에서 모듈를 선택하면 Module1이 만들어 지면 Module1을 클릭하여 VBA코드를 작성합니다. Module1 이름은 필요에 따라 변경 하시면 됩니다. 저는 outlookDownload라고 모듈 이름을 변경하였습니다.
3) 이제 VBA 코드에서 Outlook 라이브러리를 사용하여 메일 일괄 다운로드 기능을 구현 합니다.
| ⓐ "메일 일괄 다운로드" 버튼 클릭시 호출될 함수 VBA 소스코드 |
| Sub DownloadOutlookMails() Dim objNamespace As Outlook.Namespace Dim objFolder As Outlook.Folder Dim objMail As Outlook.MailItem Dim strFilePath As String Dim intCount As Integer Dim ws As Worksheet Dim rr As Integer Dim idpt As Integer Dim objShell, objPCFolder As Object CRLF = Chr(13) & Chr(10) '// 1) Outlook Namespace Object 생성 Set objNamespace = Outlook.Application.GetNamespace("MAPI") '// 2) 일괄 다운로드 할 outlook 메일함 폴더 선택하기(팝업 화면 오픈) Set objFolder = objNamespace.PickFolder '// 3) Download 메일이 저장될 PC 디렉토리 선택하기 Set objShell = CreateObject("Shell.Application") Set objPCFolder = objShell.browseForFolder(0, "메일을 다운로드 할 디렉토리를 선택하세요", 0, "C:\\") If Not objPCFolder Is Nothing Then ' 폴더를 선택함 strFilePath = objPCFolder.self.Path & "\" Else '폴더를 선택하지 않음 strFilePath = "C:\temp\" End If '// 4) 다운로드 정보를 출력할 엑셀 Worksheet 만들기 wsName = "다운로드" & Format(Now, "yyyymmddhhmm") On Error Resume Next Set ws = Application.Worksheets(wsName) ' 동일한 이름의 Worksheet가 있는지 찾는다. On Error GoTo 0 If ws Is Nothing Then ' 동일한 이름의 worksheet가 없음 Set ws = Worksheets.Add ws.Name = wsName Else ' 동일한 이름의 worksheet가 있음 ws.Cells.Delete End If ws.Activate ws.Cells(1, 1).Select rr = 1 rr = rr + 1: ws.Cells(rr, 2).Value = "####################################################################" rr = rr + 1: ws.Cells(rr, 2).Value = " 메일 폴더: " & objFolder.Name rr = rr + 1: ws.Cells(rr, 2).Value = " 다운로드 폴더: " & strFilePath rr = rr + 1: ws.Cells(rr, 2).Value = "####################################################################" '// 5) 메일 일괄 다운로드 실행 여부 최종 Confirm result = MsgBox("outlook 메일 다운로드를 시작 합니다." & CRLF & "시작하려면 '예(Y)' 버튼을 클릭하세요", vbYesNo, "cjc Excel Macro & VBA") '// 아니요(N)를 선택한 경우 실행 취소 If result = vbNo Then Exit Sub '// 예(Y)를 선택한 경우 Download 시작 If Not objFolder Is Nothing Then idpt = 0 '// 6) 메일 일괄 다운로드 실행 재귀 함수호출 ret = DownlaodOutlookMails_recurCall(objFolder, strFilePath, ws, rr, idpt) MsgBox "메일 다운로드 완료", vbOKOnly, "cjc Excel Macro & VBA" End If End Sub |
4) 메일 일괄 다운로드 실행 재귀 함수를 구현 합니다.
선택된 메일함의 하위 메일함까지 모두 탐색하고 다운로드하기 위해서는 재귀 함수 구현이 필요합니다.
| ⓑ 메일 일괄 다운로드 실행 재귀 함수 VBA 소스코드 |
| Function DownlaodOutlookMails_recurCall(objFolder As Outlook.Folder, strDir As String, ByRef ws As Worksheet, ByRef rr As Integer, ByRef idpt As Integer) Dim objNamespace As Outlook.Namespace Dim objMail As Variant Dim strFilePath As String Dim subFolder As Outlook.Folder Dim intCount, subCount As Integer Dim fname, fullpath As String If Not objFolder Is Nothing Then '// 1) 메일이 다운로드될 PC 디렉토리를 생성 합니다. strFilePath = strDir & objFolder.Name & "\" If Dir(strFilePath, vbDirectory) = "" Then MkDir strFilePath ' subDirectory 생성 End If rr = rr + 1: ws.Cells(rr, 2 + idpt).Value = "[" & objFolder.Name & "]" For ii = 2 + idpt To 11 ws.Cells(rr, ii).Interior.Color = RGB(217, 217, 217) Next '// 2) 현재 메일함 Folder에 있는 전체 메일을 Download 합니다. intCount = 1 For Each objMail In objFolder.Items If Not objMail Is Nothing Then If TypeOf objMail Is MailItem Then fname = Format(objMail.ReceivedTime, "yyyymmddhhmm") & Mid(objMail.SenderName, 1, 3) & "_" & objMail.Subject fname = Replace(fname, "<", "") fname = Replace(fname, ">", "") fname = Replace(fname, ":", "") fname = Replace(fname, Chr(34), "") fname = Replace(fname, "/", "") fname = Replace(fname, "\", "") fname = Replace(fname, "|", "") fname = Replace(fname, "?", "") fname = Replace(fname, "*", "") fname = Replace(fname, " ", "") fullpath = strFilePath & fname & ".msg" If Dir(fullpath) = "" Then objMail.SaveAs fullpath, olMSG ' 메일을 .msg 형식으로 저장 rr = rr + 1: ws.Cells(rr, 1 + idpt).Value = "(Download)": ws.Cells(rr, 2 + idpt).Value = fname: ws.Cells(rr, 2 + idpt).Select Else ' 이미 다운로드된 파일이 있는 경우 Skip rr = rr + 1: ws.Cells(rr, 2 + idpt).Value = fname: ws.Cells(rr, 2 + idpt).Select End If intCount = intCount + 1 End If End If Next objMail '// 하위 Folder가 있는 경우 탐색 Depth 증가 If objFolder.Folders.Count > 0 Then idpt = idpt + 1 End If '// 3) 전체 하위 메일함 폴더에 대해 다운로드 함수를 재귀 호출 합니다. subCount = 0 For Each subFolder In objFolder.Folders subCount = subCount + 1 ret = DownlaodOutlookMails_recurCall(subFolder, strFilePath, ws, rr, idpt) Next subFolder getSubFolder = subCount '// getSubFolder ???? '// 하위 Folder 탐색 Depth 원복 If objFolder.Folders.Count > 0 Then idpt = idpt - 1 End If Else getSubFolder = 0 '// getSubFolder ???? End If End Function |
5) 메일 일괄 다운로드 실행 버튼을 만들고 다운로드 함수를 연결 합니다.
엑셀의 "개발 도구" 메뉴로 이동하여 삽입 툴바에서 단추(양식 컨트롤)를 클릭 합니다.(그림3)
엑셀 Sheet에서 버튼이 위치할 위치를 선택하면 매크로 지정 팝업 화면이 오픈 됩니다.(그림4)
매크로 이름으로 DownloadOutlookMails을 선택 하고 확인 버튼을 클릭하면 버튼이 생성 됩니다.
버튼을 오른쪽 마우스 클릭, 팝업 메뉴에서 텍스트 폅집 메뉴를 선택하여 버튼의 타이틀을 변경 합니다.(그림5)
지금까지 잘 따라 오셨다면 이제 버튼을 클릭하여 메일 일괄 다운로드 하시면 됩니다.
(주의사항) 당연한 말이지만 PC에 Outlook이 설치되어 있고, Outlook에 메일 계정이 연결 되어 있어야 합니다.
(참고사항) VBA 개발이 처음인 분들은 인터넷에서 환경설정 방법을 검색해보시면 쉽게 따라 하실 수 있습니다.
(참고사항) 메일 일괄 다운로드가 가능 하듯 VBA 프로그램을 통해 메일 일괄 발송도 가능하겠죠. 추후 기회가 될때 메일 일괄 발송 기능도 한번 블로깅 해보겠습니다.
'엑셀 VBA 매크로' 카테고리의 다른 글
| (VBA)엑셀 조건부 서식 생성 VBA 프로그램 만들기 (0) | 2024.05.30 |
|---|---|
| (VBA)엑셀 조건부 서식이 적용된 Cell의 평가 값이 참(True)인 Cell를 찾기 (1) | 2024.05.26 |
