Option Explicit
Sub eMailActiveWorksheet()
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Dim FileName As String
Dim y As Long
Dim TempChar As String
Dim SaveName As String
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
FileName = ActiveSheet.Name & " - " & ActiveWorkbook.Name
For y = 1 To Len(FileName)
TempChar = Mid(FileName, y, 1)
Select Case TempChar
Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":"
Case Else
SaveName = SaveName & TempChar
End Select
Next y
ActiveSheet.Copy
Set Wb = ActiveWorkbook
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = "Insert Subject Here"
.Body = "Insert message here" & vbCrLf & _
"Line 2" & vbCrLf & _
"Line 3"
.To = "User@Domain.Com"
.Importance = olImportanceNormal
.Attachments.Add Wb.FullName
.Send
End With
Kill Wb.FullName
Wb.Close False
Application.ScreenUpdating = True
Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
Sub eMailActiveWorkbook()
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Wb = ActiveWorkbook
Wb.Save
With EmailItem
.Subject = "Insert Subject Here"
.Body = "Insert message here" & vbCrLf & _
"Line 2" & vbCrLf & _
"Line 3"
.To = "User@Domain.Com"
.Importance = olImportanceNormal
.Attachments.Add Wb.FullName
.Send
End With
Application.ScreenUpdating = True
Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
|