Link to home
Start Free TrialLog in
Avatar of wisemat
wisematFlag for United Kingdom of Great Britain and Northern Ireland

asked on

Use Excel to send email with prefilled message

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
Avatar of Phillip Burton
Phillip Burton

> 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.
Avatar of wisemat

ASKER

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
Try

.SendMail Destwb.Sheets(1).cells(5,3), _
Avatar of wisemat

ASKER

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
Avatar of wisemat

ASKER

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
That's much more complicated.
Avatar of wisemat

ASKER

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

Thanks
Paul
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

Avatar of wisemat

ASKER

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
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.
Avatar of wisemat

ASKER

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.
Try changing line 97 to

.Display

See if that works.
Avatar of wisemat

ASKER

Some progress I guess..

It now created the email, fills in To/Subject/Body
But doesnt attach the active spreadsheet :(
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.)
Avatar of wisemat

ASKER

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
You can add the attachment - it will be the saved version, not necessarily the current version.
Avatar of wisemat

ASKER

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

Can you change paragraph 95 to

Msgbox .Path & "\" & .Name

and tell me the result?
Or comment out line 88, and see if there is an error.
Avatar of wisemat

ASKER

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
Then try commenting out line 88, and see if there is an error.
Avatar of wisemat

ASKER

Reverted back (removed msgbox update)
Remove 88 on erro

No change, still at prefilled message with no attachment
Avatar of wisemat

ASKER

Does this work for you?  Maybe send me the file?
Undo those recent changes.

Change line 96 to

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

It should work.
Avatar of wisemat

ASKER

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.
Avatar of wisemat

ASKER

*body text
ASKER CERTIFIED SOLUTION
Avatar of Phillip Burton
Phillip Burton

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of wisemat

ASKER

Thanks Philip
Perfect solution have all the points and an A Grade for top support

Thank you