Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 271
  • Last Modified:

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
0
wisemat
Asked:
wisemat
  • 15
  • 13
1 Solution
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
> 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
 
wisematAuthor Commented:
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
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
Try

.SendMail Destwb.Sheets(1).cells(5,3), _
0
NEW Veeam Backup for Microsoft Office 365 1.5

With Office 365, it’s your data and your responsibility to protect it. NEW Veeam Backup for Microsoft Office 365 eliminates the risk of losing access to your Office 365 data.

 
wisematAuthor Commented:
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
 
wisematAuthor Commented:
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
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
That's much more complicated.
0
 
wisematAuthor Commented:
AH OK,  So are you able to help me further intergrating the 'mail a small message' part into the script?

Thanks
Paul
0
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
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
 
wisematAuthor Commented:
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
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
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
 
wisematAuthor Commented:
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
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
Try changing line 97 to

.Display

See if that works.
0
 
wisematAuthor Commented:
Some progress I guess..

It now created the email, fills in To/Subject/Body
But doesnt attach the active spreadsheet :(
0
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
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
 
wisematAuthor Commented:
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
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
You can add the attachment - it will be the saved version, not necessarily the current version.
0
 
wisematAuthor Commented:
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
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
Can you change paragraph 95 to

Msgbox .Path & "\" & .Name

and tell me the result?
0
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
Or comment out line 88, and see if there is an error.
0
 
wisematAuthor Commented:
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
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
Then try commenting out line 88, and see if there is an error.
0
 
wisematAuthor Commented:
Reverted back (removed msgbox update)
Remove 88 on erro

No change, still at prefilled message with no attachment
0
 
wisematAuthor Commented:
Does this work for you?  Maybe send me the file?
0
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
Undo those recent changes.

Change line 96 to

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

It should work.
0
 
wisematAuthor Commented:
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
 
wisematAuthor Commented:
*body text
0
 
Phillip BurtonDirector, Practice Manager and Computing ConsultantCommented:
You can add line breaks like this:

        .Body = "Whatever body you want" & Chr(13) & Chr(13) & "Whatever body you want"
0
 
wisematAuthor Commented:
Thanks Philip
Perfect solution have all the points and an A Grade for top support

Thank you
0

Featured Post

Restore individual SQL databases with ease

Veeam Explorer for Microsoft SQL Server delivers an easy-to-use, wizard-driven interface for restoring your databases from a backup. No expert SQL background required. Web interface provides a complete view of all available SQL databases to simplify the recovery of lost database

  • 15
  • 13
Tackle projects and never again get stuck behind a technical roadblock.
Join Now