Snasui Excel Forum

Code: Select all

Sub Email2()
    Dim OutlookApp As Object
    Dim MItem As Object
    Dim email_ As String
    Dim s_email_ As String
    Dim subject_ As String
    Dim body_ As String
    Dim rAll As Range
    Dim r As Range
    Dim l As Long
    Dim sh As Worksheet
    
    Set sh = Worksheets("Email")
    l = sh.Range("A" & Rows.Count).End(xlUp).Row
    Set rAll = sh.Range("A2:A" & l - 1)

    Set OutlookApp = CreateObject("Outlook.Application")
   
    Set MItem = OutlookApp.CreateItem(0)
    
    With MItem
        .SentOnBehalfOfName = sh.Range("b2").Value
        .To = VBA.Join(Application.Transpose(rAll), ";")
        .Subject = sh.Range("d2").Value
        .Body = body_ & Chr(13) & sh.Range("E2") & sh.Range("F2") & Chr(13) & _
            sh.Range("G2") & Chr(13) & sh.Range("H2") & Chr(13) & sh.Range("I2") & _
            sh.Range("J2") & Chr(13) & sh.Range("K2") & Chr(13) & sh.Range("L2") & _
            Chr(13) & sh.Range("M2") & Chr(13) & sh.Range("N2") & Chr(13) & _
            sh.Range("O2") & Chr(13) & sh.Range("P2") & Chr(13) & sh.Range("Q2") & _
            Chr(13) & sh.Range("R2") & Chr(13) & sh.Range("S2") & Chr(13) & _
            sh.Range("T2") & Chr(13) & sh.Range("U2") & Chr(13) & sh.Range("V2") & _
            Chr(13) & sh.Range("W2") & Chr(13) & sh.Range("X2") & Chr(13) & _
            sh.Range("Y2") & Chr(13) & sh.Range("Z2")
        .send
    End With

    OutlookApp = Nothing
    MItem = Nothing
    
End Sub

Code: Select all

Set OutlookApp = Nothing
Set MItem = Nothing