Solved

Code to add ranged cells from an Excel Spreadsheet in an email body

Posted on 2015-01-15
9
119 Views
Last Modified: 2015-01-21
I have the code below that works great when I want to insert cells from an excel worksheet in the body of an email.  However what if I want a range like in my code I have

MsgBody1 = Sheets("data").Range("M2")

How can I modify correctly to show cells in I1:J12 for example.  I have tables in my data I want to include in the body of an email.

Here is my code:
Function DistributeDailyConcept()
    'Declare variables
    Dim MyFilePath As String
    Dim SavePDFas As String
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem '<-- Early binding
    Dim EmailAddress As String
    Dim EmailSubject As String
    Dim MsgBody1 As String
    Dim MsgBody2 As String
    Dim ShipDate As String
    Dim wkb As Workbook
    'Dim xlApp As Excel.Application


    Excel.Application.Quit
    
    Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = True

    xlApp.Workbooks.Open "C:\Share\Daily Sales\Daily Sales Report by Concept JOM.xlsx", True, False
    
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    xlApp.DisplayAlerts = False
    
    'Create Outlook object
        Set OutlookApp = New Outlook.Application
        
    'Specify email address and email subject
        EmailAddress = "angela.mXXXXXX@XXXXXX.com"
        'EmailAddress = "rick.wXXXXXX@XXXXX.com"
        EmailSubject = "Daily Sales Report by Concept JOM"
    
    'Build parts of name of PDF file
        MyFilePath = "C:\Share\Daily Sales"
        strFile = Dir(MyFilePath & "\Daily Sales Report by Concept JOM.xlsx")
        'MyFileName = strFile
      
       Set wkb = Excel.Workbooks.Open(MyFilePath & "\" & strFile)
        
    'Specify email message
        MsgIntro = "Please find the Daily Sales Report by Concept JOM. "
        MsgBody1 = Sheets("data").Range("M2")
        MsgBody2 = Sheets("data").Range("M3")
        MsgFile = "File with all account detail is also saved at C:\Share\Daily Sales\Daily Sales Report by Concept JOM.xlsx"
        MsgEnd = "If you have any questions, please let us know...Kind Regards, NAM DTC Finance"
        ShipDate = Sheets("Data").Range("GR")
        SavePDFas = "C:\Share\Daily Sales\Daily Sales Report by Concept JOM " & ShipDate & ".pdf"
    'process the data in the workbook here
    'Save Transaction Form as PDF file in same directory as this
    'Excel workbook
        wkb.Save
        wkb.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
            SavePDFas, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False
        Excel.Application.ActiveWorkbook.Save
        wkb.Close
        Excel.Application.Quit
        xlApp.Quit
        
    'Send out the email
        Set MItem = OutlookApp.CreateItem(olMailItem)
        With MItem
            .To = EmailAddress
            .Subject = EmailSubject & " " & ShipDate
            .Body = MsgIntro & Chr(10) & Chr(10) & MsgBody1 & Chr(10) & Chr(10) & MsgBody2 & Chr(10) & Chr(10) & MsgFile & Chr(10) & Chr(10) & MsgEnd
            .Attachments.Add SavePDFas
            .Send
        End With
        
    
   
    'House cleaning
    Set OutlookApp = Nothing
    Set xlApp = Nothing
    Set XLWbk = Nothing
    Set XLSht = Nothing
    
    
    


  
  
    
End Function

Open in new window

0
Comment
Question by:gracie1972
  • 4
  • 3
  • 2
9 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40552105
try

MsgBody1 = Sheets("data").Range("I1:J12")
0
 

Author Comment

by:gracie1972
ID: 40552141
@ Rey I get a type mismatch error when I try that.
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40552164
what is the content of I1:J12 ?
upload a copy of the excel file
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 40552221
The issue is that, to do multiple "rows",... you need some sort of carriage return/Line feed to actually insert a range into a text email message body (text or HTML)
My guess is that you will have to find a way to insert this range as a table...

...but, lets see what Rey or the other experts will post

JeffCoachman
0
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 
LVL 74

Accepted Solution

by:
Jeffrey Coachman earned 500 total points
ID: 40552241
...or, (if the range will not change), you could "build" the range manually:
Something roughly like this worked for me:

YourBody = Sheets("data").Range("I1") & " , " & Sheets("data").Range("J1") & vbCrLf _
                    & Sheets("data").Range("I2") & " , " & Sheets("data").Range("J2") & vbCrLf _
                    & Sheets("data").Range("I3") & " , " & Sheets("data").Range("J3") & vbCrLf _
                    & Sheets("data").Range("I4") & " , " & Sheets("data").Range("J4") & vbCrLf _
                    & Sheets("data").Range("I5") & " , " & Sheets("data").Range("J5") & vbCrLf _
                    & Sheets("data").Range("I6") & " , " & Sheets("data").Range("J6") & vbCrLf _
                    & Sheets("data").Range("I7") & " , " & Sheets("data").Range("J7") & vbCrLf _
                    & Sheets("data").Range("I8") & " , " & Sheets("data").Range("J8") & vbCrLf _
                    & Sheets("data").Range("I9") & " , " & Sheets("data").Range("J9") & vbCrLf _
                    & Sheets("data").Range("I10") & " , " & Sheets("data").Range("J10") & vbCrLf _
                    & Sheets("data").Range("I11") & " , " & Sheets("data").Range("J11") & vbCrLf _
                    & Sheets("data").Range("I12") & " , " & Sheets("data").Range("J12")

Open in new window


JeffCoachman
0
 

Author Comment

by:gracie1972
ID: 40552268
I cant it is our daily sales template.
It is just a table with linked data from another sheet.  Might be too complicated for what I need.
0
 

Author Comment

by:gracie1972
ID: 40552269
Thanks Jeffrey I will try that.
0
 

Author Comment

by:gracie1972
ID: 40552285
That worked perfect.

Any idea as to why the SaveASPDF is not working (This code worked on another project where I only had 1 sheet)?  I have multiple sheets and I only want to save and convert one of the sheets to PDF and attach to email.

Or should I open another question?
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 40552648
I actually tested my snippet in a modified version of your code, and the PDF was created just fine.

It would be best if you posted another question for the PDF issue.

JeffCoachman
0

Featured Post

Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

24 Experts available now in Live!

Get 1:1 Help Now