F
fre
Could someone please help me with the folowing code? It is called
from a button and attaches a file to an email.
It works fine except two things.
1> It will get an error on Set EmailItem =OL.CreateItem(OLMailItem)
if outlook is not already open. How can I change it so outlook does
not have to be already open?
2> Application.Quit closes the current workbook, but does not close
excel completely. I need it to shut down completely.
Sub Button6_Click()
Dim OL As Object
Dim EmailItem As Object
Dim FileName As String
'Shut Down Screen and Events
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
' Setup OutLook Object
Application.EnableEvents = True
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(OLMailItem)
FileName = "Attachment.xls"
' Load Email
ActiveWorkbook.SaveAs "C:\" & FileName
On Error Resume Next
With EmailItem
.Subject = ActiveSheet.Name
.Body = ActiveSheet.Name
.Importance = 2 ' 0 = Low 1 = Normal 2 = High
.Attachments.Add "C:\" & FileName
.Display ' Load The Email
End With
'Shut down Excel
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Kill "C:\" & FileName
Set OL = Nothing
Set EmailItem = Nothing
Application.Quit
End Sub
from a button and attaches a file to an email.
It works fine except two things.
1> It will get an error on Set EmailItem =OL.CreateItem(OLMailItem)
if outlook is not already open. How can I change it so outlook does
not have to be already open?
2> Application.Quit closes the current workbook, but does not close
excel completely. I need it to shut down completely.
Sub Button6_Click()
Dim OL As Object
Dim EmailItem As Object
Dim FileName As String
'Shut Down Screen and Events
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
' Setup OutLook Object
Application.EnableEvents = True
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(OLMailItem)
FileName = "Attachment.xls"
' Load Email
ActiveWorkbook.SaveAs "C:\" & FileName
On Error Resume Next
With EmailItem
.Subject = ActiveSheet.Name
.Body = ActiveSheet.Name
.Importance = 2 ' 0 = Low 1 = Normal 2 = High
.Attachments.Add "C:\" & FileName
.Display ' Load The Email
End With
'Shut down Excel
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Kill "C:\" & FileName
Set OL = Nothing
Set EmailItem = Nothing
Application.Quit
End Sub