[RPA] Excel 내용을 이미지화 하여 outlook으로 메일 보내기(VB)

오늘은 도움 주신 코드가 있어서 공부하기(까먹지 않기) 위해 올립니다.

    

엑셀 내용을 이미지로 만드는 함수

Sub CreateExcelpng(SheetName As String)
'시트 내용 이미지화, SheetName엔 이미지로 만들고 싶은 시트 이름 쓰면 됨
    
    Dim Picture As Object
    Dim xRgPic As Range
    Dim xShape As Shape
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range("[이미지로 만들고 싶은 셀 범위]A1:Q50")
        
'이미지 크기 조절 이미지 사이즈 픽셀로 변경
'이미지 크기 바꾸고싶으면 원하는 가로 길이를 1100 대신 써주고 세로 길이를 2500 대신 써주면 됨
'아래부터 있는 '를 전부(총 6개) 지워줌
'안지우고 이대로 쓰면 엑셀 크기 그대로 만들어짐
    'Dim px2ptH As Double: px2ptH = 72 / 96
    'Dim px2ptV As Double: px2ptV = 72 / 96
    'Dim w As Double: w = 1100 * px2ptH
    'Dim h As Double: h = 2500 * px2ptV 
  
    xRgPic.CopyPicture xlScreen, xlBitmap
    
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        For Each xShape In ActiveSheet.Shapes
            xShape.Line.Visible = msoFalse
        Next
        '.Chart.ChartArea.Height = h
        '.Chart.ChartArea.Width = w
        .Chart.Paste
        .Chart.Export "[더블 쿼테이션 안에는 png가 생성 될 전체 경로를 써주시면 됩니다]C:\Users\1234.png", "PNG"
    End With
    
    Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
    
    Set xRgPic = Nothing
    
End Sub

 

 

이미지를 본문에 넣고 아웃룩으로 이메일 보내는 방법

Public Sub Sendmail(title As String, Mailreceiver As String, MailCC As String, imgPath As String, AttachmentPath As String)
'title은 메일 제목, imgPath는 방금 만든 img 경로를 써주면 된다
'AttachmentPath는 첨부파일이 있을 때 쓰면 됩니다. 없으면 그 줄 삭제 해주시면 됨

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2016
 Dim rng As Range
 Dim OutApp, sht As Object
 Dim OutMail As Object
 Dim PRE_TEXT As String
 Dim SURFFIX_TEXT As String
 Dim img As String
 
 Dim frontfix, middle, middle_a, middle_b, surfix As String
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
   
    
    With OutMail

        .To = Mailreceiver
        .CC = MailCC

        .Subject = title
        
        frontfix = "<br>[이미지 전에 오는 첫 문장~~]<br><br>"
                     
                     
        middle_a = "<img src='"
        middle_b = "'>"
        middle = middle_a & imgPath & middle_b
        surfix = "<br>[이미지 후에 오는 문장~html로 작성하면 됩니다.]<br><br>" & Robotsignature
        
        .htmlBody = Lfont(frontfix) & Lfont(middle) & Lfont(surfix)
        .Attachments.Add AttachmentPath
        .Display
        .send
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

'본문 글씨체 설정
'필요 없는 내용이지만 위에 썼으니 같이 올립니다.
Function Lfont(letter)
    Lfont = "<font style=""font-family: 바탕체; font-size: 10pt; color:#333333  ;"">" & letter & "</font>"
End Function

 

이미지 만들지 않고 그냥 엑셀 내용을 붙여넣고 싶을 때

Public Sub Sendmail(files As Integer)
'files는 엑셀의 내용을 몇 줄 담고싶은지 숫자로 쓰면 된다.
'예를 들어 엑셀 A1에서 5행만 보내면 되면 5을 써주면 됨
'범위 설정은 14번줄에서 하면 된다. 즉 꼭 A1에서 가져오지 않아도 됨
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2016
 Dim rng As Range
 Dim OutApp, sht As Object
 Dim OutMail As Object

    Set sht = Sheets("[시트이름]")
    Set rng = Sheets("[시트이름]").Range([메일 보내고 싶은 범위]"A1:B" & (files))
    mailDate = Replace(Format(Date, "mm/dd"), "-", "/")

    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    Title = ""
    If Title = "" Then
        Title = "[하고싶은 제목]"
    End If
    
    
    With OutMail
'
        .To = "[받을 사람]"
        .CC = "[참조할 사람]"

        .Subject = Title
        PRE_TEXT = "첫 본문 내용, 엑셀 내용으로 시작할거면 빈칸으로 두면 됨"
        SURFFIX_TEXT = "엑셀 내용 넣은 후 쓰고싶은 내용, html코드로 쓰면 된다 <br><br>"
        .htmlBody = Lfont(PRE_TEXT) & RangetoHTML(rng, sht) & Lfont(SURFFIX_TEXT)
        .Display
        .send
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

Function RangetoHTML(rng As Range, sht As Object)  
'"여기가 outlook에 표 붙이는 부분이에요!
'여긴 아직 해석 안했읍니다.

    ' Changed by Ron de Bruin 28-Oct-2006
    ' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    Set TempWB = Workbooks.Add(1)
    With TempWB
        sht.Copy after:=Worksheets(1)
        Application.DisplayAlerts = False
        Worksheets(1).Delete
    On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
    On Error GoTo 0
    End With
    
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
        Filename:=TempFile, _
        Sheet:=TempWB.Sheets(1).Name, _
        Source:=rng.Address, _
        HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
    "align=left x:publishsource=")
    
    'Close TempWB
    TempWB.Close SaveChanges:=False
    
    'Delete the htm file we used in this function
    Kill TempFile
    
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing

End Function

Function Lfont(letter)
    Lfont = "<font style=""font-family: 바탕체 Regular; font-size: 11pt; color:#333333  ;"">" & letter & "</font>"
End Function

 

 

엑셀 내용을 아웃룩으로 보낼 때 위처럼 두가지 방법이 있으나

둘 다 어찌보면 비슷한 내용이기도 하고

아무튼 나는 둘 다 썼었다.

필요한 사람은 한 줄씩 분석 해 가며 사용하시길 바랍니다..

물론 저도 검색해서 나온거 + 주신 코드 입니다.

 

 

혹시 uipath로 vb코드 쓰는 법 모르는 사람 있을까봐,, 대충 쓰는데

위 코드를 메모장에 써서 ANSI로 저장한 다음,

이렇게 Excel Scope안에 Invoke VBA를 해주면 된다.

꼭 메모장 아니여도 되고 .vb로 저장해도 됨.

 

 

파라미터는 필요 없어도 갯수 맞춰서 {}안에 써주면 된다. 대부분 스트링으로 받아서 "내용~~"이렇게 보내줬지만

파라미터 타입이 integer면 숫자만 써야하고 아무튼 이런 기본적인건 다 알고 있을 것 같다..

 

끗

 

 

+

추가로, 아웃룩 계정이 여러개일 때

Send Account를 변경하고 싶다면,

Set .SendUsingAccount = OutApp.Session.Accounts.Item(1)

이것을 OutMail 안에 넣어주면 된다(.htmlBody나 .Distplay처럼) 

1번이 기본이고, 그 안에 계정을 써도 된다