Outlook을 이용하여 Email 발송하기

간단하게 메이를 발송하기 위한 코드를 정리합니다.

 

함수로 제작을 하고, 받을 인수는 수신주소, 메일제목, 메일본무, 첨부파일 4가지로 합니다.

수신인은 수신만 있는 String 이거나, 수신/참조/숨은참조를 넣은 배열로 받을 수 있도록 Variant로 선언하고

본문과 첨부는 없어도 에러는 아니므로 Optional 처리

첨부파일도 다일파일 Path는 String이고, 여러 첨부파일으 Path를 넣은 배열로 받기 위해 Variant로 합니다.

Function SendMailwithOutlook(vReceipt As Variant, _
                             sTitle As String, _
                             Optional sBody As Variant = "", _
                             Optional vAttachments As Variant = "")

 

Outlook App은 Object로 선언하고, CreateObject("Outlook.application")로 Late binding해 줍니다.

메일 문서는 CreateItem(olMailItem) 으로 새로 만들어 할당합니다.

혹시 Outlook이 설치되어 있지 않으면 발생하는 오류도 처리해 줍니다.

Outlook이 설치되었더라도, Profile이 설정되지 않거나 계정이 설정되지 않은 오류도 처리합니다.

    Dim olApp As Object  
    Dim oMail As Object   
    
    On Error Resume Next
    Set olApp = CreateObject("Outlook.application")
    If olApp Is Nothing Then SendMailwithOutlook = "ERROR:Outlook을 사용할 수 없습니다.": Exit Function
    On Error GoTo 0
    If olApp.DefaultProfileName = "" Then SendMailwithOutlook = "ERROR:Outlook이 초기 설정이 진행되지 않았습니다.": Exit Function
    If olApp.Session.Accounts.Count = 0 Then SendMailwithOutlook = "ERROR:Outlook에 유효한 계정이 설정되지 않았습니다.": Exit Function
    Set oMail = olApp.CreateItem(olMailItem)

 

수신이에 대해서는 인수 형식에 따라 처리합니다.

혹시 여러 주소를 쉼표( , )로 연결한 경우 세미콜론( ; )으로 대체해 줍니다.

        If TypeName(vReceipt) = "Ragne" Or isArray(vReceipt) Then
            For Each vItem In vReceipt
                If vItem <> "" And InStr(1, vItem, "@") = 0 Then SendMailwithOutlook = "ERROR:수신인 지정이 잘못되었습니다.": Exit Function
                i = i + 1
                If i = 1 Then .To = Replace(vItem, ",", ";")
                If i = 2 Then .CC = Replace(vItem, ",", ";")
                If i = 3 Then .BCC = Replace(vItem, ",", ";")
            Next
        ElseIf TypeName(vReceipt) = "String" Then
            .To = Replace(vReceipt, ",", ";")
        Else
            SendMailwithOutlook = "ERROR:수신인 지정이 잘못되었습니다.": Exit Function
        End If

 

첨부파일에 대해서도 동일하게 처리하는데 파일Path가 유효한지 Dir() 함수로 확인합니다.

        If TypeName(vAttachments) = "Ragne" Or isArray(vAttachments) Then
            For Each vItem In vAttachments
                If InStr(1, vItem, Application.PathSeparator) = 0 Then SendMailwithOutlook = "ERROR:첨부파일에 오류가 있습니다.": Exit Function
                If Dir(vItem) = "" Then SendMailwithOutlook = "ERROR:첨부파일에 오류가 있습니다.": Exit Function
                .Attachments.Add vItem
            Next
        ElseIf TypeName(vAttachments) = "String" Then
            If vAttachments <> "" Then
                If Dir(vAttachments) = "" Then SendMailwithOutlook = "ERROR:첨부파일에 오류가 있습니다.": Exit Function
                .Attachments.Add vAttachments
            End If
        Else
            SendMailwithOutlook = "ERROR:첨부파일에 오류가 있습니다.": Exit Function
        End If

 

Outlook으로 발송하는 것은 비교적 간단합니다.

Function SendMailwithOutlook(vReceipt As Variant, sTitle As String, Optional sBody As Variant = "", Optional vAttachments As Variant = "")
'// Microsoft OUTLOOK을 이용하여 메일을 발송합니다.
    '//vReceipt는 수신인이 To 하나만 있으면 String으로 받아도 됨
    '//vReceipt는 3개의 배열에 Lbound에 To, LB+1에 CC, LB+2에 BCC 주소들을 쉼표(,)를 이용해서 넣음 , ->; 변경
    '//sBody는 HTML코드나 일반 Text 가능
    '//vAttachments에는 첨부에 대한 FullPathName을 넣는데, 여러개라면 배열로 넣는다.
    Dim olApp As Object                    '// Outlook.Application
    Dim oMail As Object                    '// Outlook.MailItem
    Dim sFilePath As String
    Dim vItem As Variant, i As Long
    Const olMailItem As Long = 0
    
    On Error Resume Next
    Set olApp = CreateObject("Outlook.application")
    If olApp Is Nothing Then SendMailwithOutlook = "ERROR:Outlook을 사용할 수 없습니다.": Exit Function
    On Error GoTo 0
    If olApp.DefaultProfileName = "" Then SendMailwithOutlook = "ERROR:Outlook이 초기 설정이 진행되지 않았습니다.": Exit Function
    If olApp.Session.Accounts.Count = 0 Then SendMailwithOutlook = "ERROR:Outlook에 유효한 계정이 설정되지 않았습니다.": Exit Function
    
    Set oMail = olApp.CreateItem(olMailItem)
    With oMail
        '// 수신인 반영
        If TypeName(vReceipt) = "Ragne" Or isArray(vReceipt) Then
            For Each vItem In vReceipt
                If vItem <> "" And InStr(1, vItem, "@") = 0 Then SendMailwithOutlook = "ERROR:수신인 지정이 잘못되었습니다.": Exit Function
                i = i + 1
                If i = 1 Then .To = Replace(vItem, ",", ";")
                If i = 2 Then .CC = Replace(vItem, ",", ";")
                If i = 3 Then .BCC = Replace(vItem, ",", ";")
            Next
        ElseIf TypeName(vReceipt) = "String" Then
            .To = Replace(vReceipt, ",", ";")
        Else
            SendMailwithOutlook = "ERROR:수신인 지정이 잘못되었습니다.": Exit Function
        End If
        
        '// 제목과 본문을 반영
        .Subject = sTitle
        If sBody <> "" Then .HTMLBody = sBody
        
        '// 첨부파일 추가
        If TypeName(vAttachments) = "Ragne" Or isArray(vAttachments) Then
            For Each vItem In vAttachments
                If InStr(1, vItem, Application.PathSeparator) = 0 Then SendMailwithOutlook = "ERROR:첨부파일에 오류가 있습니다.": Exit Function
                If Dir(vItem) = "" Then SendMailwithOutlook = "ERROR:첨부파일에 오류가 있습니다.": Exit Function
                .Attachments.Add vItem
            Next
        ElseIf TypeName(vAttachments) = "String" Then
            If vAttachments <> "" Then
                If Dir(vAttachments) = "" Then SendMailwithOutlook = "ERROR:첨부파일에 오류가 있습니다.": Exit Function
                .Attachments.Add vAttachments
            End If
        Else
            SendMailwithOutlook = "ERROR:첨부파일에 오류가 있습니다.": Exit Function
        End If
        
        '// 메일 발송, True반환
        .Send
        SendMailwithOutlook = True
    End With
    
    Set olApp = Nothing: Set oMail = Nothing
End Function