rajagopal
03-25-2009, 12:34 AM
Hi,
I've an excel file which attach the current workbook to outlook as below:
To: abc@xyz.com and CC: def@xyz.com
subject: XXXXX and Message body: "Hi......"
I've used the below code:
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
I want the recipient list to be changed on satisfying a condition when cell value E9=USA, mail it to
To: def@xyz.com (def@xyz.com) and CC: abc@xyz.com (abc@xyz.com)
subject: XXXXX and Message body: "Hi......"
When cell value E9=Europe, mail it to
To: ghi@xyz.com (ghi@xyz.com) and CC: def@xyz.com
subject: XXXXX and Message body: "Hi......"
When cell value E9=Middle East, mail it to
To: klm@xyz.com (klm@xyz.com) and CC: pqr@xyz.com (pqr@xyz.com)
subject: XXXXX and Message body: "Hi......"
You can refer thread - http://www.vbaexpress.com/forum/showthread.php?t=21422
to refer for the above codes.
Thanks.
I've an excel file which attach the current workbook to outlook as below:
To: abc@xyz.com and CC: def@xyz.com
subject: XXXXX and Message body: "Hi......"
I've used the below code:
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
I want the recipient list to be changed on satisfying a condition when cell value E9=USA, mail it to
To: def@xyz.com (def@xyz.com) and CC: abc@xyz.com (abc@xyz.com)
subject: XXXXX and Message body: "Hi......"
When cell value E9=Europe, mail it to
To: ghi@xyz.com (ghi@xyz.com) and CC: def@xyz.com
subject: XXXXX and Message body: "Hi......"
When cell value E9=Middle East, mail it to
To: klm@xyz.com (klm@xyz.com) and CC: pqr@xyz.com (pqr@xyz.com)
subject: XXXXX and Message body: "Hi......"
You can refer thread - http://www.vbaexpress.com/forum/showthread.php?t=21422
to refer for the above codes.
Thanks.