[Word] 메일 머지(병합) VBA로 개인화 제목/본문 발송

대량 메일 발송은 많은 유료서비스가 있다.

이러한 서비스를 이용해 간편하게 이른바 개인화된 맞춤형 메일을 발송할 수 있다.

그러나, 그 발송 빈도가 적은 직무나 조직에서는 이러한 고정비용이 발생하는 것이 부담스럽고, 또 조직에서 사용하고 있는 그룹웨어를 통해 일부나마 그 기능이 갖춰져 있다면 불필요한 이중지출이 된다.

나의 경우에도 현재 조직에서 사용하고 있는 메일 그룹웨어가 존재하고, 전시회 참가를 통해 확보된 리드에 발송하기 위함이라 굳이 새로운 서비스를 사용하기 보다는 기존의 무료툴에서 찾아보기로 했다. 그래서 그룹웨어를 Outlook으로 연동하여 MS Word의 메일 머지(병합) 기능을 사용하자는 결론에 도달했다.

문제 - 제목과 본문 모두 개인화된 메일 발송

Word의 메일 Merge 기능은 사용이 매우 쉽다.

먼저 Outlook으로 메일을 POP/MAP등으로 연동해두고 Word 상단 네비 메뉴에서 편지>받는 사람 선택을 클릭하여 데이터를 연동해준다. 다음 병함 필드를 삽입하여 머지할 필드를 구성해준다.

그리고 문서를 작성한 다음, 완료 및 병합으로 메일을 발송할 수 있다.

그러나, 치명적인 단점이 있다.

제목은 병합 기능이 작동하지 않는다.

화면 녹화 중 2024-11-18 222417.mp4

0.79MB

이 부분은 이미 MS에서 공식적으로 인정했다.

리디렉션 중

해결 - VBA로 메일 머지 기능 대체하기

따라서 이 문제를 해결하기 위해 Word의 VBA를 활용하기로 했다.

1. 데이터셋 만들기

먼저, 메일 머지를 만들 데이터셋부터 만들어준다.

간단하게 Email, Subject, Content, Attachment로 구성했다. 그리고 예시용으로 더미 데이터를 만들어봤다.

Attachment는 실제 첨부하고자하는 파일의 주소를 입력하면 된다.

2. Word로 불러오기

앞선 방법과 동일하게 '받는 사람 선택 > 기존 목록 사용'으로 데이터셋을 불러온다.

목록 편집으로 데이터를 잘 불러왔는데 확인하고 이상이 없다면 이제 준비는 모두 끝났다.

3. VBA 코드 작성 및 실행하기

VBA 창을 열어서 다음 매크로를 입력해준다.

각 코드는 간단하게 입력한 레코드를 순회하면서 Email, Subject, Content, Attachment를 기준으로 메일을 발송하는 코드이다.

사실 메일 머지가 아니라 자동 메일 발송 코드이다. 다만 실제로 발송이 필요하니 Outlook을 연동한 것 뿐이다.

사용했던 실제 첨부파일과 VBA코드를 첨부해두었으니, 필요하신 분은 마음껏 사용하시면 되겠다!

Sub SendPersonalizedEmailsWithAttachments()
    Dim OutlookApp As Object
    Dim MailItem As Object
    Dim DataDoc As Document
    Dim Recipients As MailMergeDataSource
    Dim TotalRecords As Long

    ' Word 문서 및 데이터 소스 초기화
    Set DataDoc = ActiveDocument
    Set Recipients = DataDoc.MailMerge.DataSource

    ' 총 레코드 수 확인
    TotalRecords = Recipients.RecordCount
    If TotalRecords = 0 Then
        MsgBox "데이터 소스에 레코드가 없습니다."
        Exit Sub
    End If

    ' Outlook 초기화
    Set OutlookApp = CreateObject("Outlook.Application")

    ' 메일 병합 데이터 순회
    Recipients.ActiveRecord = wdFirstRecord
    Do
        ' 필드 값 읽기
        Dim EmailAddress As String
        Dim EmailSubject As String
        Dim EmailBody As String
        Dim AttachmentPath As String

        EmailAddress = Recipients.DataFields("Email")
        EmailSubject = Recipients.DataFields("Subject")
        EmailBody = Recipients.DataFields("Content")
        AttachmentPath = Recipients.DataFields("Attachment") ' 첨부파일 경로

        If EmailAddress <> "" Then
            ' 메일 발송 로직
            Set MailItem = OutlookApp.CreateItem(0)
            With MailItem
                .To = EmailAddress
                .Subject = EmailSubject
                .Body = EmailBody

                ' 첨부파일 추가
                If AttachmentPath <> "" Then
                    If Dir(AttachmentPath) <> "" Then ' 파일이 존재할 경우
                        .Attachments.Add AttachmentPath
                    Else
                        MsgBox "첨부파일 경로가 잘못되었습니다: " & AttachmentPath
                    End If
                End If

                .Send
            End With
        Else
            MsgBox "이메일 주소가 비어 있습니다. 해당 레코드는 건너뜁니다."
        End If

        ' 다음 레코드로 이동
        If Recipients.ActiveRecord = TotalRecords Then Exit Do
        Recipients.ActiveRecord = wdNextRecord
    Loop

    MsgBox "모든 메일이 발송되었습니다!"
End Sub