엑셀 VBA 메일 보내기 자동화 매크로 만들기

---

엑셀 VBA 메일 자동 보내기 매크로

---

아웃룩을 이용한 엑셀 메일 보내기 매크로입니다.

많은 사람들에게 메일을 보내야 할 때 사용하시면 편합니다. 

첨부파일이 개인마다 다른 경우에도 하나하나 첨부하여 보낼 수 있습니다.

단, 첨부 파일명의 형식은 같아야 합니다. ex) 이름_첨부파일명.pdf

 

조건

1. 아웃룩에 송신이 가능한 메일 주소로 로그인이 되어 있어야 합니다. 
2. 엑셀 개발 도구 탭 오픈
3. 엑셀 개발도구의 참조에서 Microsoft Office 15.0 Object Library 체크가 되어 있어야 합니다. (오피스 버전에 따라 저 숫자는 다르게 보일 수 있습니다.)

 

엑셀은 default로 개발 도구 탭이 오픈되지 있지 않습니다.

아래와 같이 조치하셔서 개발 도구 탭을 오픈하셔야 합니다.

 

엑셀 개발 도구 탭 오픈 방법

1. 파일 탭 > 옵션 > 리본 사용자 지정 클릭
2. 오른쪽 리본 메뉴 사용자 지정(B) 항목에서 개발 도구란의 체크 박스 클릭 > 확인 버튼 클릭
3. 확인

엑셀 개발 도구 탭 오픈 방법

엑셀 개발 도구 탭 오픈 방법

 

Microsoft Office 15.0 Object Library 체크

1. 활성화된 개발 도구 탭 클릭 > Visual Basic 클릭

2. 도구 > 참조(R)... 클릭

3. 스크롤을 내려 Microsoft Office 15.0 Object Library 체크하시고 확인 클릭

엑셀 VBA 메일 보내기 자동화 매크로 만들기

엑셀 VBA 메일 보내기 자동화 매크로 만들기

엑셀 VBA 메일 보내기 자동화 매크로 만들기

 

엑셀 Sheet 구성

 - 엑셀 Sheet는 아래와 같이 구성하여 주시길 바랍니다. 

1. Sheet1에는 메일주소와 사용자 이름을 기록합니다.
2. Sheet2에는 메일 본문 내용을 기록합니다.

엑셀 Sheet 구성

 

엑셀 Visual Basic 개발 환경 오픈

1. 엑셀 개발 도구 탭 > Visual Basic 클릭
2. 모듈 추가

엑셀 Visual Basic 개발 환경 오픈

모듈이 안보인다면 위의 삽입 클릭 후 모듈을 선택해도 됩니다.

엑셀 Visual Basic 개발 환경 오픈

 

엑셀 Visual Bacsic 소스 코드 작성

추가된 모듈에서 작성합니다. 

전체 소스코드는 아래와 같습니다.

    Function FileChk(sFileName As String)       '첨부파일 유무 체크 함수
        Dim sChkFile As String

        sChkFile = Dir(sFileName)
        If (Len(sChkFile) > 0) Then
            FileChk = True
        Else
            FileChk = False
        End If
    End Function


Sub SendMail()

    '변수 설정
    Dim F_dir As FileDialog
    Dim F_Name As String
    Dim M_Add As String
    Dim File_N As String
    Dim eEmail As String
    Dim M_name As String
    Dim W_Row, i, pos As Integer
    Dim MyOutlook As Object
    Dim N_Email As Object
    Dim Response As String
    Dim Response2 As String
    
    
    '메일 발송 확인 메시지 박스
    Response = MsgBox("메일을 발송하시겠습니까?", vbYesNo)
    
    
    '메일 발송 Yes 인 경우에만 실행
    If Response = vbYes Then
            
        Response2 = MsgBox("첨부파일이 있습니까?", vbYesNo)     '첨부파일 유무 체크
        
            If Response2 = vbYes Then               '첨부 파일이 있을 경우에만 실행
                Set F_dir = Application.FileDialog(msoFileDialogFolderPicker)   '첨부파일이 있는 위치를 지정하기 위한 다이얼로그
                F_dir.AllowMultiSelect = False
                F_dir.Title = "첨부파일이 있는 위치를 선택하십시오."
                F_dir.Show
                F_Name = F_dir.SelectedItems(1)     '파일 경로 가져오기
            End If

            W_Row = Sheet1.Range("A60000").End(xlUp).Row            '끝 행 찾기

            For i = 2 To W_Row              'Sheet1의 2번째 행부터 끝 행인 W_Row 까지 실행
                M_Add = ""                  '메일 주소 초기화
                M_name = ""                 '이름 초기화

                '엑셀 셀 표기 방법 -> (1,1)=(1,A)=A1
                M_Add = Sheet1.Cells(i, 1)          '메일주소가져오기(2,1)=A2=(2,A)
                M_name = Sheet1.Cells(i, 2)         '이름가져오기(2,2)=B2=(2, B)

                '메일주소만 추출하기
                pos = InStr(M_Add, "@")     'abc@naver.com 메일주소에서 @가 있는 자리수 찾기
                eEmail = Left(M_Add, pos - 1)       '@ 있는 자리수에서 -1만큼 뺀 자리수까지만 데이터 가져오기

                If F_Name <> "" Then        '첨부파일이 있을 경우 실행
                    File_N = F_Name & "\" & eEmail & "_" & M_name & "_" & "첨부파일.pdf"    '첨부파일 경로 및 이름
                End If
                                
               '아웃룩 오픈
               If M_Add <> "" Then
                    Set MyOutlook = CreateObject("Outlook.Application")
                    Set N_Email = MyOutlook.CreateItem(olMailItem)

                    With N_Email
                        .To = M_Add           '수신인 메일주소
                        .CC = ""              '참조 메일주소
                        .Subject = "제목"       '메일 제목
                        .Body = Sheet2.Cells(1, 1).Value        'Sheet2의 A1 셀의 내용 가져오기
                        If Response2 = vbYes Then
                            If (FileChk(File_N)) Then               '첨부파일이 있을 경우 첨부(첨부파일이 없을 경우 첨부하지 않습니다.)
                                .Attachments.Add File_N                 '첨부파일 첨부
                            End If
                        End If
                        .Send
                    End With
                End If
        Next i
        
        MsgBox "끝"
    End If
 End Sub

반응형

복사는 아래 파일을 다운로드 받으셔서 하시면 됩니다. 

메일보내기.txt

0.00MB

 

실행을 위한 버튼 만들기

1. 개발 도구 탭 클릭 > 삽입 클릭 -> 양식 컨트롤에서 단추(양식 컨트롤) 클릭
2. 버튼를 만들어 놓을 장소에 마우스 드래그로 원하는 크기의 버튼 생성
3. 생성된 버튼의 매크로 지정하여 확인 버튼 클릭
4. 생성된 버튼 확인
5. 단추명은 마우스 우클릭하여 수정 가능합니다.

실행을 위한 버튼 만들기

 

 

생성된 버튼을 클릭하면 매크로 실행됩니다.

 

응용

1. 각 사용자마다 본문 내용을 달리 해서 보낼 수도 있습니다.
   
   • 먼저 Sheet2 에 사용자 별 본문 내용을 다 작성합니다.
   • .Body = Sheet2.Cells(1,1).value 이 부분을 반복문으로 돌려서 적용하면 됩니다.
2. Sheet1의 형식도 변경 가능합니다.
   • 예를 들어 테이블 형식으로 구성되어 있고 메일주소가 적혀 있는 열이 유동적이라면 행에서 "메일 주소"가 있는 열을 찾아서 그 열의 데이터를 가져오면 됩니다.
3. 첨부 파일명이 다른 경우
   • 위 예제는 첨부파일 명이 메일주소_이름_첨부파일.pdf 이렇게 들어가게 되어 있습니다.
   • 첨부 파일명은 각 상황에 맞게 끔 변경하시면 됩니다.
   • 단 F_Name이 첨부파일이 있는 경로이므로 가장 앞에 와야 합니다.
   • File_N = File_Name & "\" & 까지는 고정입니다. 이 이후를 수정하시면 됩니다.
   • 변수와 문자열을 이어주는 구문은 & 입니다.

충분히 응용하여 사용 가능하니 필요하신 기능을 댓글로 남겨 주시면 조언해 드리도록 하겠습니다.