Option Explicit
Sub eMailActiveWorksheet()
Dim OL
As Object
Dim EmailItem
As Object
Dim Wb
As Workbook
Dim WbName
As String
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(0)
FileName = Range("B12").Value & " Server Form"
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
'//Here
On Error Resume Next
Err.clear
Wb.SaveAs SaveName
If Err<>0 then
msgbox(savename)
goto exithere
End if
'//To here (Plus label below)
Wb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = "Server Form - " & Range("B12").Value
.Body = "Server Form Attached"
' & vbCrLf & _
"Line 2" & vbCrLf & _
"Line 3"
.To = "johndoe
@abc123.com"
'.CC = ""
'.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Wb.FullName
.Send
End With
'//Added
EXITHERE:
WbName = Wb.FullName
Wb.Close
False
Set Wb =
Nothing
Set OL =
Nothing
Set EmailItem =
Nothing
Kill WbName
Application.ScreenUpdating =
True
End Sub [/vba]