엑셀 VBA 메일 보내기 자동화 매크로 만들기
아웃룩을 이용한 엑셀 메일 보내기 매크로입니다.
많은 사람들에게 메일을 보내야 할 때 사용하시면 편합니다.
첨부파일이 개인마다 다른 경우에도 하나하나 첨부하여 보낼 수 있습니다.
단, 첨부 파일명의 형식은 같아야 합니다. ex) 이름_첨부파일명.pdf
조건
- 아웃룩에 송신이 가능한 메일 주소로 로그인이 되어 있어야 합니다.
- 엑셀 개발 도구 탭 오픈
- 엑셀 개발도구의 참조에서 Microsoft Office 15.0 Object Library 체크가 되어 있어야 합니다. (오피스 버전에 따라 저 숫자는 다르게 보일 수 있습니다.)
엑셀은 default로 개발 도구 탭이 오픈되지 있지 않습니다.
아래와 같이 조치하셔서 개발 도구 탭을 오픈하셔야 합니다.
엑셀 개발 도구 탭 오픈 방법
- 파일 탭 > 옵션 > 리본 사용자 지정 클릭
- 오른쪽 리본 메뉴 사용자 지정(B) 항목에서 개발 도구란의 체크 박스 클릭 > 확인 버튼 클릭
- 확인
Microsoft Office 15.0 Object Library 체크
1. 활성화된 개발 도구 탭 클릭 > Visual Basic 클릭
2. 도구 > 참조(R)... 클릭
3. 스크롤을 내려 Microsoft Office 15.0 Object Library 체크하시고 확인 클릭
엑셀 Sheet 구성
- 엑셀 Sheet는 아래와 같이 구성하여 주시길 바랍니다.
- Sheet1에는 메일주소와 사용자 이름을 기록합니다.
- Sheet2에는 메일 본문 내용을 기록합니다.
엑셀 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반응형
복사는 아래 파일을 다운로드 받으셔서 하시면 됩니다.
실행을 위한 버튼 만들기
- 개발 도구 탭 클릭 > 삽입 클릭 -> 양식 컨트롤에서 단추(양식 컨트롤) 클릭
- 버튼를 만들어 놓을 장소에 마우스 드래그로 원하는 크기의 버튼 생성
- 생성된 버튼의 매크로 지정하여 확인 버튼 클릭
- 생성된 버튼 확인
- 단추명은 마우스 우클릭하여 수정 가능합니다.
생성된 버튼을 클릭하면 매크로 실행됩니다.
응용
- 각 사용자마다 본문 내용을 달리 해서 보낼 수도 있습니다.
- 먼저 Sheet2 에 사용자 별 본문 내용을 다 작성합니다.
- .Body = Sheet2.Cells(1,1).value 이 부분을 반복문으로 돌려서 적용하면 됩니다.
- Sheet1의 형식도 변경 가능합니다.
- 예를 들어 테이블 형식으로 구성되어 있고 메일주소가 적혀 있는 열이 유동적이라면 행에서 "메일 주소"가 있는 열을 찾아서 그 열의 데이터를 가져오면 됩니다.
- 첨부 파일명이 다른 경우
- 위 예제는 첨부파일 명이 메일주소_이름_첨부파일.pdf 이렇게 들어가게 되어 있습니다.
- 첨부 파일명은 각 상황에 맞게 끔 변경하시면 됩니다.
- 단 F_Name이 첨부파일이 있는 경로이므로 가장 앞에 와야 합니다.
- File_N = File_Name & "\" & 까지는 고정입니다. 이 이후를 수정하시면 됩니다.
- 변수와 문자열을 이어주는 구문은 & 입니다.
충분히 응용하여 사용 가능하니 필요하신 기능을 댓글로 남겨 주시면 조언해 드리도록 하겠습니다.
'IT > Office' 카테고리의 다른 글
| [Excel] 엑셀 - 셀 삽입 오류, 데이터의 손실을 방지하기 위해 데이터가 들어 있는 셀을 워크 시트 밖으로 이동할 수 없습니다. 오류 해결 방법 (0) | 2022.10.11 |
|---|---|
| 엑셀 VBA 파일명 일괄 변경하기 (0) | 2022.07.07 |
| 엑셀 SUMIF (0) | 2022.01.17 |
| 오피스2019 설치 파일 다운로드 img - 링크 (프로그램 X) (6) | 2021.09.07 |
| [Office] 오피스2019 크랙 없이 정품 인증하는 방법 (425) | 2021.04.07 |
댓글