Solved

Use Excel to send email with prefilled message

Posted on 2015-01-28
28
213 Views
Last Modified: 2015-02-02
Hello Experts,

I have a script I use to send the current active worksheet to outlook.  It prefills the subject and attaches the spreadsheet.
I am using Outlook and Excel 2010

I would like this to be improved and wonder if you can help me.

Firstly: Could the To: be prefilled with the user in cell C5
Finally: Could I also prefill the body of the message with some prepard text (html/rich format)

The script I currently use is here and I have attached the spread sheet as an example.  I have very limited scripting skills so I throw myself on your expertise.

Thank you experts
Paul
Sub Mail_ActiveSheet()
' Works in Excel 97 through Excel 2007.
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String

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

Set Sourcewb = ActiveWorkbook
' Using ActiveSheet.Copy creates a new workbook with
' the sheet and the file format is the same as the
' original workbook.
' Copy the worksheet to a new workbook.
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

' Determine the Excel version and file extension/format.
With Destwb
   If Val(Application.Version) < 12 Then
      ' You are using Excel 97-2003.
      FileExtStr = ".xls": FileFormatNum = -4143
   Else
      ' You are using Excel 2007.
      ' When you use ActiveSheet.Copy to create a workbook,
      ' you are prompted with a security dialog. If you click No
      ' in the dialog, then the name of Sourcewb is the same
      ' as Destwb and you exit the subroutine. You only see this
      ' dialog when you attempt to copy a worksheet from an .xlsm file with macros disabled.
      If Sourcewb.Name = .Name Then
         With Application
            .ScreenUpdating = True
            .EnableEvents = True
         End With
         MsgBox "Your answer is No in the security dialog."
         Exit Sub
      Else
         Select Case Sourcewb.FileFormat
            ' Code 51 represents the enumeration for a macro-free
            ' Excel 2007 Workbook (.xlsx).
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            ' Code 52 represents the enumeration for a
            ' macro-enabled Excel 2007 Workbook (.xlsm).
            Case 52:
               If .HasVBProject Then
                  FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                  FileExtStr = ".xlsx": FileFormatNum = 51
               End If
            ' Code 56 represents the enumeration for a
            ' a legacy Excel 97-2003 Workbook (.xls).
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            ' Code 50 represents the enumeration for a
            ' binary Excel 2007 Workbook (.xlsb).
             Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
         End Select
      End If
   End If
End With

' Change all cells in the worksheet to values, if desired.
''   With Destwb.Sheets(1).UsedRange
''      .Cells.Copy
''      .Cells.PasteSpecial xlPasteValues
''      .Cells(1).Select
''   End With
''Application.CutCopyMode = False

'Save the new workbook and then mail it.
   TempFilePath = Environ$("temp") & "\"
   TempFileName = ActiveSheet.Name

With Destwb
   .SaveAs TempFilePath & TempFileName, FileFormat:=FileFormatNum
      On Error Resume Next
   .SendMail "", _
      "Your User Report for 2015"
      On Error GoTo 0
   .Close SaveChanges:=False
End With
 
' Delete the file you just sent.
Kill TempFilePath & TempFileName & FileExtStr

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

Open in new window

Excel-Example.xlsx
0
Comment
Question by:wisemat
  • 15
  • 13
28 Comments
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40575506
> Firstly: Could the To: be prefilled with the user in cell C5

Change

.SendMail "", _

to

.SendMail .cells(5,3), _

assuming that contains sufficient for .SendMail to work out that that is an email address (but you don't have any email address in your example).

> Finally: Could I also prefill the body of the message with some prepard text (html/rich format)

I don't believe you can using SendMail - you would need to have Outlook on your computer to do that - see http://www.rondebruin.nl/win/s1/outlook/bmail4.htm for example code.
0
 

Author Comment

by:wisemat
ID: 40575536
Thanks Philip,

The chance to SendMail .cells(5,3), _ did not work in my example.  I simply edited the script using Alt-F11 and selecting its module then resaving and running.

I'll take a look at that link you sent me now.

Kind regards
Paul
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40575541
Try

.SendMail Destwb.Sheets(1).cells(5,3), _
0
 

Author Comment

by:wisemat
ID: 40575560
YES!  That has solved my first request thank you!

Can you help my intergrate this to include the 'mail a small message' link you sent me, I am using outlook to send my message.

Else I'll split the points for you :)

With thanks
Paul
0
 

Author Comment

by:wisemat
ID: 40577027
An alternative solution could be to send a message from drafts or a template?  IS that possible with outlook and excel?
Just thinking aloud.

Regards
Paul
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40577035
That's much more complicated.
0
 

Author Comment

by:wisemat
ID: 40577036
AH OK,  So are you able to help me further intergrating the 'mail a small message' part into the script?

Thanks
Paul
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40577075
As per that article - change lines 81-82 to

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

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

    On Error Resume Next
    With OutMail
        .To = Destwb.Sheets(1).cells(5,3)
        .CC = ""
        .BCC = ""
        .Subject = "Your User Report for 2015"
        .Body = "Whatever body you want"
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

Open in new window

0
 

Author Comment

by:wisemat
ID: 40577085
Thanks Philip,

I think there is a small issues somewhere, it is not warning me that a program is trying to send email like the previous update did and indeed I am not receiving anything.  The code I am using entered ok:

Sub Mail_ActiveSheet()
' Works in Excel 97 through Excel 2007.
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
   
With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook
' Using ActiveSheet.Copy creates a new workbook with
' the sheet and the file format is the same as the
' original workbook.
' Copy the worksheet to a new workbook.
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

' Determine the Excel version and file extension/format.
With Destwb
   If Val(Application.Version) < 12 Then
      ' You are using Excel 97-2003.
      FileExtStr = ".xls": FileFormatNum = -4143
   Else
      ' You are using Excel 2007.
      ' When you use ActiveSheet.Copy to create a workbook,
      ' you are prompted with a security dialog. If you click No
      ' in the dialog, then the name of Sourcewb is the same
      ' as Destwb and you exit the subroutine. You only see this
      ' dialog when you attempt to copy a worksheet from an .xlsm file with macros disabled.
      If Sourcewb.Name = .Name Then
         With Application
            .ScreenUpdating = True
            .EnableEvents = True
         End With
         MsgBox "Your answer is No in the security dialog."
         Exit Sub
      Else
         Select Case Sourcewb.FileFormat
            ' Code 51 represents the enumeration for a macro-free
            ' Excel 2007 Workbook (.xlsx).
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            ' Code 52 represents the enumeration for a
            ' macro-enabled Excel 2007 Workbook (.xlsm).
            Case 52:
               If .HasVBProject Then
                  FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                  FileExtStr = ".xlsx": FileFormatNum = 51
               End If
            ' Code 56 represents the enumeration for a
            ' a legacy Excel 97-2003 Workbook (.xls).
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            ' Code 50 represents the enumeration for a
            ' binary Excel 2007 Workbook (.xlsb).
             Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
         End Select
      End If
   End If
End With

' Change all cells in the worksheet to values, if desired.
''   With Destwb.Sheets(1).UsedRange
''      .Cells.Copy
''      .Cells.PasteSpecial xlPasteValues
''      .Cells(1).Select
''   End With
''Application.CutCopyMode = False

'Save the new workbook and then mail it.
   TempFilePath = Environ$("temp") & "\"
   TempFileName = ActiveSheet.Name

With Destwb
   .SaveAs TempFilePath & TempFileName, FileFormat:=FileFormatNum
      On Error Resume Next
          Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

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

    On Error Resume Next
    With OutMail
        .To = Destwb.Sheets(1).Cells(5, 3)
        .CC = ""
        .BCC = ""
        .Subject = "with body"
        .Body = "Whatever body you want"
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

      On Error GoTo 0
   .Close SaveChanges:=False
End With
 
' Delete the file you just sent.
Kill TempFilePath & TempFileName & FileExtStr

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

Open in new window


I'm guessing on error it's not alerting me and just going to end
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40577105
No, you need a utility such as ClickYes - http://www.contextmagic.com/express-clickyes/

You can thank Microsoft since it has been necessary since Outlook 2002 SP2.
0
 

Author Comment

by:wisemat
ID: 40577114
Thanks for clickyes.

So as I said Im not getting the popup or any error when running your modification, but it also is not sending the emai.  
Does it work for you?

In the previous step to add the sender from cell C5, that step workeed and that when i started getting the popup.
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40577115
Try changing line 97 to

.Display

See if that works.
0
 

Author Comment

by:wisemat
ID: 40577123
Some progress I guess..

It now created the email, fills in To/Subject/Body
But doesnt attach the active spreadsheet :(
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40577477
I don't think it can attach it. You are asking Outlook to attach the current version of the spreadsheet which is open, and it won't be able to do that.

It could attach the last saved version - maybe change line 96 to

        .Attachments.Add (.Path & "\" & .Name)

(Note - delete the ' at the beginning of it.)
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:wisemat
ID: 40583998
Hi philip,

So I'm confused how the original script was able to email a copy of the active worksheet, then we tweaked the code and we were able to email a copy of the active spreadsheet to the email address at cell C5 - so far so good

Then we tweaked again to include a message body and not the attachement part if not working.  Does this mean what i am aking is not possible?

Thanks
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40584002
You can add the attachment - it will be the saved version, not necessarily the current version.
0
 

Author Comment

by:wisemat
ID: 40584009
Changed line 96 as requested, no change to the outcome, no attachment unlike the original script

For reference:
Sub EmailRecertToC5WithBody()
' Works in Excel 97 through Excel 2007.
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
   
With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook
' Using ActiveSheet.Copy creates a new workbook with
' the sheet and the file format is the same as the
' original workbook.
' Copy the worksheet to a new workbook.
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

' Determine the Excel version and file extension/format.
With Destwb
   If Val(Application.Version) < 12 Then
      ' You are using Excel 97-2003.
      FileExtStr = ".xls": FileFormatNum = -4143
   Else
      ' You are using Excel 2007.
      ' When you use ActiveSheet.Copy to create a workbook,
      ' you are prompted with a security dialog. If you click No
      ' in the dialog, then the name of Sourcewb is the same
      ' as Destwb and you exit the subroutine. You only see this
      ' dialog when you attempt to copy a worksheet from an .xlsm file with macros disabled.
      If Sourcewb.Name = .Name Then
         With Application
            .ScreenUpdating = True
            .EnableEvents = True
         End With
         MsgBox "Your answer is No in the security dialog."
         Exit Sub
      Else
         Select Case Sourcewb.FileFormat
            ' Code 51 represents the enumeration for a macro-free
            ' Excel 2007 Workbook (.xlsx).
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            ' Code 52 represents the enumeration for a
            ' macro-enabled Excel 2007 Workbook (.xlsm).
            Case 52:
               If .HasVBProject Then
                  FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                  FileExtStr = ".xlsx": FileFormatNum = 51
               End If
            ' Code 56 represents the enumeration for a
            ' a legacy Excel 97-2003 Workbook (.xls).
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            ' Code 50 represents the enumeration for a
            ' binary Excel 2007 Workbook (.xlsb).
             Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
         End Select
      End If
   End If
End With

' Change all cells in the worksheet to values, if desired.
''   With Destwb.Sheets(1).UsedRange
''      .Cells.Copy
''      .Cells.PasteSpecial xlPasteValues
''      .Cells(1).Select
''   End With
''Application.CutCopyMode = False

'Save the new workbook and then mail it.
   TempFilePath = Environ$("temp") & "\"
   TempFileName = ActiveSheet.Name

With Destwb
   .SaveAs TempFilePath & TempFileName, FileFormat:=FileFormatNum
      On Error Resume Next
          Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

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

    On Error Resume Next
    With OutMail
        .To = Destwb.Sheets(1).Cells(5, 3)
        .CC = ""
        .BCC = ""
        .Subject = "with body"
        .Body = "Whatever body you want"
        'You can add a file like this
        .Attachments.Add (.Path & "\" & .Name)
        .Display  'or use .Display or .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

      On Error GoTo 0
   .Close SaveChanges:=False
End With
 
' Delete the file you just sent.
Kill TempFilePath & TempFileName & FileExtStr

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

Open in new window

0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40584013
Can you change paragraph 95 to

Msgbox .Path & "\" & .Name

and tell me the result?
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40584023
Or comment out line 88, and see if there is an error.
0
 

Author Comment

by:wisemat
ID: 40584024
The result is no different to previous two updates:

To, Subject and Body are prefilled but no attachment.  I am left with an email waiting to send
No msgbox appeared
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40584028
Then try commenting out line 88, and see if there is an error.
0
 

Author Comment

by:wisemat
ID: 40584029
Reverted back (removed msgbox update)
Remove 88 on erro

No change, still at prefilled message with no attachment
0
 

Author Comment

by:wisemat
ID: 40584030
Does this work for you?  Maybe send me the file?
0
 
LVL 24

Expert Comment

by:Phillip Burton
ID: 40584049
Undo those recent changes.

Change line 96 to

        .Attachments.Add (destwb.Path & "\" & destwb.Name)

It should work.
0
 

Author Comment

by:wisemat
ID: 40584069
Philip,

Thats almost perfect! Everythign is prefilled and the attachment is now working!
The bosy text is only one sentence long though, can this be expanded to say a couple of paragraphs?  I need to explain w3hat the attached report is.
0
 

Author Comment

by:wisemat
ID: 40584073
*body text
0
 
LVL 24

Accepted Solution

by:
Phillip Burton earned 500 total points
ID: 40584077
You can add line breaks like this:

        .Body = "Whatever body you want" & Chr(13) & Chr(13) & "Whatever body you want"
0
 

Author Closing Comment

by:wisemat
ID: 40584136
Thanks Philip
Perfect solution have all the points and an A Grade for top support

Thank you
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Resolve DNS query failed errors for Exchange
Follow this checklist to learn more about the 15 things you should never include in an email signature from personal quotes, animated gifs and out-of-date marketing content.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

708 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

16 Experts available now in Live!

Get 1:1 Help Now