이 페이지에서
구문
Send_Email MailTo, Subject, HTMLString, [PasteRng], [CCTo], [BCCTo], [AttachFilePath], [PathDelimiter], [DeliveryTime], [ImmediateSend], [PasteAsImage], [InsertSignature]
인수구분
형식 설명
MailTo
필수
String
받을 사람의 메일 주소입니다.
Subject
필수
String
메일 제목입니다.
HTMLString
필수
String
HTML 형식의 메일 본문입니다.
PasteRng
선택
Range
메일에 붙여넣기 할 엑셀 범위입니다. 기본값은 Nothing 입니다.
CCTo
선택
String
참조 메일 주소입니다. 기본값은 빈 문자열입니다.
BCCTo
선택
String
숨은참조 메일 주소입니다. 기본값은 빈 문자열입니다.
AttachFilePath
선택
String
첨부파일 경로입니다. 기본값은 빈 문자열입니다.
여러 파일은 구분자로 구분하여 입력합니다.
PathDelimiter
선택
String
여러 개의 첨부파일 경로를 구분할 구분자입니다. 기본값은 "|" 입니다.
DeliveryTime
선택
Date
예약발송 시간을 지정합니다. 기본값은 0(현재 시간 발송)입니다.
ImmediateSend
선택
Boolean
작성한 메일을 검토 없이 바로 보낼지 여부를 결정합니다. 기본값은 FALSE 입니다.
PasteAsImage
선택
Boolean
TRUE일 경우 그림 형식으로, FALSE일 경우 표 형식으로 붙여넣기합니다. 기본값은 FALSE 입니다.
InsertSignature
선택
Boolean
TRUE일 경우 서명을 삽입합니다. 기본값은 TRUE 입니다.
마스터 코드
복사한 코드는 VBA 편집기(Alt + F11) 새 모듈에 붙여넣어 사용하세요'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ 명령문 : Send_Email
'▶ 설명 : 아웃룩과 연동하여 메일보내기를 자동화하는 모듈입니다.
'▶ 인수 설명
'_____________MailTo : 받을 사람의 메일 주소입니다.
'_____________Subject : 메일 제목입니다.
'_____________HTMLString : HTML 형식의 메일 본문입니다.
'_____________PasteRng : 메일에 붙여넣기 할 엑셀 범위입니다.
'_____________CCTo : 참조 메일 주소입니다.
'_____________BCCTo : 숨은참조 메일 주소입니다.
'_____________AttachFilePath : 첨부파일 경로입니다. ("|"로 여러개의 파일을 구분합니다.)
'_____________PathDelimiter : 여러개의 첨부파일을 구분할 구분자입니다.
'_____________DeliveryTime : 예약발송할 날짜입니다. 기본값은 현재시간입니다.
'_____________ImmediateSend : True 일 경우 메일 작성 후 검토 없이 바로 보냅니다.
'_____________PasteAsImage : True 일 경우 이미지 형식으로 붙여넣기 합니다. False일 경우 표 형식으로 붙여넣기 합니다.
'_____________InsertSignature : True 일 경우 서명을 삽입합니다.
'▶ 사용된 기타 사용자지정함수
'▶ 그외 참고사항
'######################################################################
Sub Send_Email(MailTo As String, _
Subject As String, _
HTMLString As String, _
Optional PasteRng As Range = Nothing, _
Optional CCTo As String = "", _
Optional BCCTo As String = "", _
Optional AttachFilePath As String = "", _
Optional PathDelimiter As String = "|", _
Optional DeliveryTime As Date, _
Optional ImmediateSend As Boolean = False, _
Optional PasteAsImage As Boolean = False, _
Optional InsertSignature As Boolean = True)
Dim AppOutlook As Outlook.Application
Dim newEmail As Outlook.MailItem
Dim pageInspector As Outlook.Inspector
Dim pageEditor As Object
Dim varFilePath As Variant
Dim FileCount As Long
Dim i As Long
Dim wdPasteDefault As Variant
Dim wdPasteBitmap As Variant
Dim Signature As String
Set AppOutlook = New Outlook.Application
Set newEmail = AppOutlook.CreateItem(olMailItem)
If IsDate(DeliveryTime) = False Then
MsgBox "올바른 예약발송 시간을 입력하세요."
Exit Sub
End If
If AttachFilePath <> "" Then
varFilePath = Split(AttachFilePath, PathDelimiter)
End If
With newEmail
.To = MailTo
.CC = CCTo
.BCC = BCCTo
.Subject = Subject
If AttachFilePath <> "" Then
For i = 1 To UBound(varFilePath) + 1
.Attachments.Add varFilePath(i - 1), 1, i
Next
End If
.Display
If InsertSignature = True Then Signature = .HTMLBody
.HTMLBody = HTMLString
If DeliveryTime = 0 Then DeliveryTime = Now
.DeferredDeliveryTime = DeliveryTime
If Not PasteRng Is Nothing Then
Set pageInspector = newEmail.GetInspector
Set pageEditor = pageInspector.WordEditor
PasteRng.Copy
pageEditor.Application.Selection.Start = Len(.Body)
If PasteAsImage = False Then
pageEditor.Application.Selection.PasteAndFormat wdPasteDefault
Else
pageEditor.Application.Selection.InsertAfter vbNewLine
pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.PasteSpecial Placement:=1, DataType:=wdPasteBitmap
End If
End If
.HTMLBody = .HTMLBody & Signature
If ImmediateSend = True Then
.Send
End If
End With
Set pageEditor = Nothing
Set pageInspector = Nothing
Set newEmail = Nothing
Set AppOutlook = Nothing
End Sub
활용 예제
표 범위 붙여넣기 · 예약 발송 메일 작성
Send_Email MailTo:="test@oppadu.com", _
Subject:="메일 테스트", _
HTMLString:="안녕하세요? 테스트 발송용 메일입니다.", _
PasteRng:=Sheet1.Range("A9:E15"), _
DeliveryTime:="2019-12-25 08:00:00", _
ImmediateSend:=False, _
PasteAsImage:=False
안내사항
PC에 아웃룩(Outlook)이 설치되어 있어야 합니다.
실행 전 VBA 편집기의 '도구 → 참조'에서 Microsoft Outlook 16.0 Object Library를 활성화해야 합니다.
강의 잘 봤습니다.
user form에서 command button을 클릭시에 메일 보내기를 활성화 시키려면 어떻게 해야하나요?
mylovehdh@nate.com로 메일 주시면 문의 사항 파일로 보내드리겠습니다.
확인 부탁드립니다 ㅠ
위에 다운로드 버튼을 클릭해서 예제파일을 다운받으신 뒤, 매크로 편집창을 보시면 Test 명령문이 있습니다. 해당 명령문을 command 버튼에 연결하시면 됩니다.
유저폼 설정방법은 이전 네이버 로그인 유저폼 만들기 강의에서 자세히 설명드린적이 있으니 아래 링크를 참고해보시겠어요?^-^
https://www.oppadu.com/엑셀-vba-강의-네이버-구글-자동로그인-폼-만들기-2/
제 답변이 도움이 되셨길 바랍니다.
감사합니다.
Sub Send_Email(MailTo As String, _
Subject As String, _
HTMLString As String, _
Optional PasteRng As Range = Nothing, _
Optional CCTo As String = "", _
Optional BCCTo As String = "", _
Optional AttachFilePath As String = "", _
Optional PathDelimiter As String = "|", _
Optional DeliveryTime As Date, _
Optional ImmediateSend As Boolean = False, _
Optional PasteAsImage As Boolean = False)
해당 강의에서 소개해드린 매크로는, 기존 아웃룩의 동일한 프로세스를 사람대신 매크로가 진행하는 것이므로 스팸으로 분류될 이유는 없을듯 합니다..^^;
혹시 사내 메일서버에서 특정 발신인이 짧은시간내에 몇개 이상의 메일을 다량으로 보낼경우 스팸으로 분류되는 것은 아닐까요?..
메일이 스팸으로 분류되는 정확한 사안을 말씀해주시면, 다른 해결책을 확인해보겠습니다^_^
감사합니다.
소중한 문의 감사드립니다. 확인 결과, 해당 오류는 bitmap 을 이용한 클립보드 붙여넣기 오류로 확인하였습니다.
따라서 아래 부분을
pageEditor.Application.Selection.InsertAfter vbNewLine
pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.PasteSpecial Placement:=1, DataType:=wdPasteBitmap
아래와 같이 바꿔보시겠어요?^^ 바로 해결되실겁니다.
pageEditor.Application.Selection.InsertAfter vbNewLine
pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.PasteAndFormat 13
답변이 도움이 되셨길 바랍니다.
감사합니다.
말씀대로 바로 해결되었습니다 ^^
pageEditor.Application.Selection.PasteAndFormat 13 을 사용하여 붙여넣기 성공하였습니다.
하지만, 붙여넣기 할 영역의 사이즈가 커서 그런지 동일하게 아래 부분이 조금 안보이는 증상이 발생합니다.
outlook 에 붙여넣기 된 그림을 선택하여 레이아웃 옵션에서 텍스트 배치를 수정하면 정상적으로 모두 보이는데, 다른 방법이 없을까요 ??
텍스트배치를 수정하신다는게 정확히 어떤 절차를 말씀하시는건가요? 만약 정렬모드 변경을 말씀하시는거라면 매크로를 한번 더 수정해주셔야 할 듯 합니다.
https://imgur.com/upload?beta
위 링크를 사용해서 관련 이미지를 추가해주시거나 Q&A 게시판에 좀 더 자세히 설명해주시겠어요?
확인 후 답변드리겠습니다.
감사합니다.
사진을 올려주신 링크를 다시 적어주시겠어요? 확인부탁드립니다.
아래 링크 보내 드립니다. 제가 빼 먹었습니다.
노란색 부분으로 마크 해두었습니다.
https://imgur.com/CVOG2SD
답변이 도움이 되셨길 바랍니다.
감사합니다.
물론 가능합니다.
공식의 PasteRange 인수를 상황에 맞춰 적절히 변경하시면 여러개의 시트 범위를 가져올 수도 있습니다.
다만 VBA에서 제공되는 내장함수는 '같은시트' 범위만 병합할 수 있으므로,
- 원하는 범위를 임시시트에서 병합
- 병합된 범위 출력 후
- 임시 시트를 삭제
하는 방식으로 추가 함수를 제작해서 진행해주셔야 합니다.^^
제시해드린 답변이 도움 되셨길 바랍니다.
감사합니다.
근데 2019 버전에서 실행 시키면,
Set AppOutlook = New Outlook.Application
이 부분에서 첨부와 같이 에러가 발생하는데, 방법이 없을까요?
(2019 이하 버전에서는 잘 작동 됩니다. MSOUTL.OLB 라이브러리 추가도 했습니다.)
64비트 엑셀에서 발생하는 일시적인 오류로 보입니다.
관련 자료 찾아보니, 아래 해결책이 있어 링크와 같이 적어드립니다.
런타임오류 -2147467229 해결
윈도우 화면 왼쪽아래 돋보기 -> Regedit -> 레지스트리 편집기 실행
이후 아래 레즈스트리 키로 이동
HKEY_CLASSES_ROOT\WOW6432Node\CLSID\{0006F03A-0000-0000-C000-000000000046}
레지스트리 삭제 후, 오피스 복구 실행하면 해결 된다고 하니 참고해보시길 바랍니다.^^
https://community.spiceworks.com/topic/2248037-getting-runtime-error-2147467229-80004023-in-excel-vba-macro
사실 저도 엑셀 자신 있다고 생각해서 교육 이런거 해볼까도 생각 했는데,
야나두님 교육 들으면서 아 내가 진짜 해변가에 조개껍데기를 줍고 있었었구나 하고 포기 했어요 ㅎㅎㅎ
대신 더 열심히 해야겠구나 열정이 불탄다는~ ㅎㅎ
정말 너무 감사해요~ 혹시라도 저도 도움이 될 수 있을만한게 있었으면 좋겠네요~
감사합니다. 좋은 하루 보내세요~
많은 도움이 되었습니다. 감사합니다.
To. 에서 수신자가 2명 이상일 경우 에러가 발생하는데요. 혹시 수신자를 2명 이상 추가할 수 있을까요?
감사합니다.
수신자가 여러명일경우 세미콜론(;)으로 구분해서 입력하시면 됩니다.^^
abc@naver.com; abcd@gmail.com 형태로 입력해보세요.
확인 감사합니다.
수신자는 .To = Range("H32") 로 설정하였습니다.
.To = Range("H32") & ";" & Range ("H33") 이렇게 수신자를 2명으로 하고싶은데, 적용이 안되네요^^;;
.To = Range("H32") & ";" & Range ("H33")
위 작성하신 명령문에는 문제가 없어 보입니다.^^;Set newEmail = AppOutlook.CreateItem(olMailItem)
요 부분에서 '287' 런타임 오류가 발생하였습니다 라고 에러 나는데 왜 그런건지 궁금합니다.
이 코드를 사용할때는 서명이 없는 상태로 내용만 있었으면 합니다.
서명제거는 어떻게 하나요?
명령문에
를 지우거나
InsertSignature 옵션을 false로 사용하시면 됩니다.
다름이 아니라 제가 하고자 하는건, '복사 후 영역해제' 입니다.
표를 아웃룩에 복사 붙여넣기 한 후, '복사 영역'을 해제하고 싶은데, 어디 부분에 어떤 명령문을 작성해야하는지 모르겠습니다..
매크로를 녹화해보니 "Application.CutCopyMode = False"가 출력되던데... 이 구문을 어디에다가 넣어야 오류가 안뜰까요?
뒷 부분에 한번 추가해보시겠어요? :)
감사합니다.