View Full Version : Solved: send active worksheet to outlook mail recipient as an attachment
rajagopal
08-08-2008, 02:16 AM
#1 - when the user close an excel file, the user will get a pop-up "Have you updated the details of A,B,C" using worksheet_beforeclose function.
If you user select Yes, then "thank you" message will be displayed.
#2 - When user click "OK" in the Thank you info, the current worksheet has to be sent to outlook mail recipient as an attachment.
To: abc@xyz.com and CC: def@xyz.com
subject: XXXXX and Message body: "Hi......"
I want the code for the action #2. I attached the excel sheet having the code.
Please help me...
Thanks.
Bob Phillips
08-08-2008, 04:01 AM
Public Sub CreateMail()
Dim mpOL As Object
Dim mpTemp As Workbook
Dim mpTempFilepath As String
Dim mpTempFilename As String
Dim mpFileExt As String
Dim mpFileFormat As Long
On Error GoTo CreateMail_Error
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
mpTempFilepath = Environ$("temp") & Application.PathSeparator
mpTempFilename = ActiveSheet.Name & " " & Format(Now, "yyyy-mm-dd hh-mm-ss")
ActiveSheet.Copy
Set mpTemp = ActiveWorkbook
If Val(Application.Version) < 12 Then
mpFileExt = ".xls"
mpFileFormat = -4143
Else
mpFileExt = ".xlsx"
mpFileFormat = 51
End If
mpTemp.SaveAs mpTempFilepath & mpTempFilename & mpFileExt, FileFormat:=mpFileFormat
Set mpOL = GetOutlookApp
If Not mpOL Is Nothing Then
Call CreateMailMessage(mpOL, mpTemp)
End If
CreateMail_Exit:
On Error Resume Next
mpTemp.Close SaveChanges:=False
Kill mpTempFilepath & mpTempFilename & mpFileExt
Set mpOL = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
CreateMail_Error:
Resume CreateMail_Exit
End Sub
Private Function GetOutlookApp() As Object
Dim mpOL As Object
On Error Resume Next
Set mpOL = GetObject(, "Outlook.Application")
If mpOL Is Nothing Then
Set mpOL = CreateObject("Outlook.Application")
End If
Set GetOutlookApp = mpOL
End Function
Private Function CreateMailMessage(ByRef OL As Object, _
ByRef TotalsWb As Workbook)
Dim mpMail As Object
OL.Session.Logon
Set mpMail = OL.CreateItem(0)
On Error Resume Next
With mpMail
.To = "abc@xyz.com"
.CC = "def@xyz.com"
.BCC = ""
.Subject = "XXXX"
.body = "Hi ..."
.Attachments.Add TotalsWb.FullName
OL.Visible = True
.Display
End With
Set mpMail = Nothing
End Function
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.