엑셀 Send_Email 명령문 사용법 및 전체 명령문 :: 메일 보내기 자동화

'###############################################################
'오빠두엑셀 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