wisemat
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
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
Excel-Example.xlsx
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
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 ), _
.SendMail Destwb.Sheets(1).cells(5,3
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
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
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
Just thinking aloud.
Regards
Paul
That's much more complicated.
ASKER
AH OK, So are you able to help me further intergrating the 'mail a small message' part into the script?
Thanks
Paul
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
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:
I'm guessing on error it's not alerting me and just going to end
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
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.
You can thank Microsoft since it has been necessary since Outlook 2002 SP2.
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.
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.
.Display
See if that works.
ASKER
Some progress I guess..
It now created the email, fills in To/Subject/Body
But doesnt attach the active spreadsheet :(
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.)
It could attach the last saved version - maybe change line 96 to
.Attachments.Add (.Path & "\" & .Name)
(Note - delete the ' at the beginning of it.)
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
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.
ASKER
Changed line 96 as requested, no change to the outcome, no attachment unlike the original script
For reference:
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
Can you change paragraph 95 to
Msgbox .Path & "\" & .Name
and tell me the result?
Msgbox .Path & "\" & .Name
and tell me the result?
Or comment out line 88, and see if there is an error.
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
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.
ASKER
Reverted back (removed msgbox update)
Remove 88 on erro
No change, still at prefilled message with no attachment
Remove 88 on erro
No change, still at prefilled message with no attachment
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.
Change line 96 to
.Attachments.Add (destwb.Path & "\" & destwb.Name)
It should work.
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.
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.
ASKER
*body text
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Philip
Perfect solution have all the points and an A Grade for top support
Thank you
Perfect solution have all the points and an A Grade for top support
Thank you
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.