none
Generating an email, calling out specific cells, using VBA RRS feed

  • Question

  • Hello,

    I want to generate an Email from VBA to send out a brief text, as well as attach the excel file. A couple of things this Email needs to contain/do:

    1) This excel file needs to save when the Email is generated, and the file name needs to be the shown text found in cell B7. 

    2) The subject of the email needs to be the shown text found in cell B7.

    3) The email needs to contain the excel file as an attachment.

    4) The email needs to display the shown text found in cell B7.

    I've got the VBA to generate the email, attach the file, and display the text, however, I need the specific 4 things from above.  Please have a look.

    Sub Mail_Range()
        'Working in Excel 2000-2013
        'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
        Dim Source As Range
        Dim Dest As Workbook
        Dim wb As Workbook
        Dim TempFilePath As String
        Dim TempFileName As String
        Dim FileExtStr As String
        Dim FileFormatNum As Long
        Dim OutApp As Object
        Dim OutMail As Object
        Dim aCell As Range

        Set Source = Nothing
        On Error Resume Next

        For Each aCell In Worksheets("Email List").Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row)
            If aCell <> "" Then
                eTo = eTo & aCell & ";"
            End If
        Next
        eTo = Left(eTo, Len(eTo) - 1)

        If Not IsEmpty(Range("B4")) Then
            Set Source = ActiveSheet.Range("a3", ActiveSheet.Range("e3").End(xlDown))
        End If

        On Error GoTo 0

        If Source Is Nothing Then
            MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
            Exit Sub
        End If

        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        Set wb = ActiveWorkbook
        Set Dest = Workbooks.Add(xlWBATWorksheet)

        Source.Copy
        With Dest.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial Paste:=xlPasteValues
            .Cells(1).PasteSpecial Paste:=xlPasteFormats
            .Cells(1).Select
            Application.CutCopyMode = False
        End With

        TempFilePath = Environ$("temp") & "\"
        TempFileName = "IJR_" & wb.Name

        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2013
            FileExtStr = ".xlsx": FileFormatNum = 51
        End If

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        With Dest
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
            On Error Resume Next
            With OutMail
                .to = "john.davis@hp.com"
                .CC = ""
                .BCC = ""
                .Subject = "New IJR_" & wb.Name
                .Body = "Please see attached IJR for approval."
                .Attachments.Add Dest.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
                .Display   'or use .Send
            End With
            On Error GoTo 0
            .Close savechanges:=False
        End With

        Kill TempFilePath & TempFileName & FileExtStr

        Set OutMail = Nothing
        Set OutApp = Nothing

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub

    Wednesday, October 18, 2017 10:12 PM

All replies

  • Hi,

    This is the forum to discuss questions and feedback for Microsoft Excel features, I'll move your question to the MSDN forum for Excel

    https://social.msdn.microsoft.com/Forums/en-US/home?forum=exceldev

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.


    Regards,
    Emi Zhang
    TechNet Community Support

    Please remember to mark the replies as answers if they helped.
    If you have feedback for TechNet Subscriber Support, contact tnmff@microsoft.com.

    Thursday, October 19, 2017 8:00 AM
  • Hi JED4114,

    Here are my suggestions.

    1)TempFileName = "IJR_" & wb.Name=>TempFileName = Dest.Sheets(1).Range("B7")

    2).Subject = "New IJR_" & wb.Name=>.Subject  = Dest.Sheets(1).Range("B7")

    3)No need for changing

    4)Do you mean show text in cell B7 to the body of the mail

    If so,

    .Body = "Please see attached IJR for approval."=>.Body = Dest.Sheets(1).Range("B7")

    Best Regards,

    Terry


    MSDN Community Support Please remember to click &quot;Mark as Answer&quot; the responses that resolved your issue, and to click &quot;Unmark as Answer&quot; if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Proposed as answer by Terry Xu - MSFT Wednesday, November 1, 2017 3:02 AM
    Friday, October 20, 2017 7:20 AM