Excel -> PDF 변환 메일 발송

Excel VBA 매크로 작성 코드

• 행, 열 확인할 것
• Outlook 2016 설치, 계정 필요
• 출력물 - PDF
• 저장 경로 - C:\

Sub MAIL()

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
    .HTMLBody = HTMLString
 
    '.DeferredDeliveryTime = DateAdd("n", 5, Now)
    .DeferredDeliveryTime = DateSerial(2030, 1, 1) + TimeSerial(8, 0, 0)
 
End With

End Sub
Sub 출력()
'
' 출력 Macro
    Dim outlookApp As Outlook.Application
    Dim myMail As Outlook.MailItem
    Dim source_file, to_emails, cc_emails As String
    Dim i, j As Integer
    
'    Set outlookApp = New Outlook.Application
 '   Set myMail = outlookApp.CreateItem(olMailItem)
    
    
    i = 4
    While True
        If Range("J" & i).Value = "" Then Exit Sub
        If Range("O" & i).Value = "Y" And Range("J" & i).Value <> "" Then
            Range("J" & i).Select
            Selection.Copy
            Range("G4:H4").Select
            ActiveSheet.Paste
            
            Range("K" & i).Select
            Selection.Copy
            Range("C4:E4").Select
            ActiveSheet.Paste
            
            Range("N" & i).Select
            Selection.Copy
            Range("C6").Select
            ActiveSheet.Paste
            
            Range("Q" & i).Select
            Selection.Copy
            Range("Q1").Select
            ActiveSheet.Paste
            
            ActiveWorkbook.Worksheets(1).Range("A1:I34").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                "C:\" & Range("J" & i).Value & "_출석확인증.pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
            
            Send_Email Cells(i, 13), _
             "영어문 출석확인증 ", _
            "안녕하세요, 영어문입니다. " & vbNewLine _
                            & "출석확인증 보내드립니다. 감사합니다. " & vbNewLine & "Thanks", _
            True, _
            "", , _
            "C:\" & Range("J" & i).Value & "_출석확인증.pdf"
            
'            "<p><span style=""font-family: NanumGothic, 나눔고딕, sans-serif; font-size: 9pt;""><b><u><span style=""font-size: 9pt;"">오빠두 대리</span></u></b> 님께&nbsp " & _
                            " ;</span></p><p><br></p><p><span style=""font-family: NanumGothic, 나눔고딕, sans-serif; font-size: 9pt;"">귀하의 <b><u><span style=""font-size: 9pt;"">2019년 10월 급여명세서</span></u></b>를 송부드립니다.&nbsp;</span></p><p><span style=""font-family: NanumGothic, 나눔고딕, sans-serif; font-size: 9pt;"">오빠두엑셀을 위한 귀하의 노고에 깊은 감사드리며 더욱 발전된 모습으로 귀하에 노고에 보답하겠습니다.</span></p>"
            
        End If
        i = i + 1
    Wend
        
    
    For i = 2 To 4
    Next i
        
End Sub


Sub Send_Email(MailTo As String, _
                Subject As String, _
                HTMLString As String, _
                Optional PasteSelection As Boolean = False, _
                Optional CCTo As String = "", _
                Optional BCCTo As String = "", _
                Optional AttachFilePath As String = "", _
                Optional PathDelimiter As String = "|")
 
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                               '// For문 반복문의 변수
Dim wdPasteDefault As Variant
 
Set AppOutlook = New Outlook.Application
Set newEmail = AppOutlook.CreateItem(olMailItem)
 
 
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
    .HTMLBody = HTMLString
 
    '.DeferredDeliveryTime = DateAdd("n", 5, Now)
    .DeferredDeliveryTime = Now
 
    If PasteSelection = True Then
        .Display
        Set pageInspector = newEmail.GetInspector
        Set pageEditor = pageInspector.WordEditor
        pageEditor.Application.Selection.Start = Len(.Body)
 
        Selection.Copy
        pageEditor.Application.Selection.PasteAndFormat wdPasteDefault
    Else
        .Display
    End If
 
    .Send    '// 메일을 보내려면 주석처리를 해제하세요.
 
End With
 
Set pageEditor = Nothing
Set pageInspector = Nothing
Set newEmail = Nothing
Set AppOutlook = Nothing
 
End Sub