Macro for mailing reports

Sub Send_Confirmation()

ActiveWorkbook.Save
    
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Sheets("Order Confirmation").Visible = True
    Application.Goto Reference:="Order_Confirmation"
        ActiveSheet.Copy
            
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = True
        .DisplayStatusBar = True
        .DisplayFormulaBar = True
        .MoveAfterReturn = True
    End With
    
    Dim x As CommandBar
        For Each x In Application.CommandBars
            x.Enabled = True
        Next
        
With ActiveWorkbook
    .SaveAs "c:\Dreams IO.xls", FileFormat:=xlNormal
End With
    
yesno = MsgBox(" This will generate an e-mail confirmation for the Dreams Coordinator" _
    & vbCrLf & " Do you wish to send the Confirmation?" _
        , vbYesNo + vbQuestion, "Confirmation Generation")

Select Case yesno
    Case vbNo
    Exit Sub
End Select
Select Case yesno
    Case vbYes

'   Declare Variables for file and macro setup

Dim UserName As String
    Dim MailDbName As String
        Dim Maildb As Object
            Dim MailDoc As Object
        Dim AttachME As Object
    Dim Session As Object
Dim EmbedObj1 As Object

'   Open and locate current LOTUS NOTES User

Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
    If Maildb.IsOpen = True Then
        Else
            Maildb.OPENMAIL
    End If

'   Create New Mail and Address Title Handlers

Set MailDoc = Maildb.CREATEDOCUMENT

MailDoc.Form = "Memo"
    MailDoc.SendTo = "RECIPIENT@ANYCOMPANY.com"
        MailDoc.Subject = "New T&E Insertion Order"
    MailDoc.Body = _
"Attached is a new Insertion Order for the Dreams publication.  Please acknowledge receipt."

'   Select Workbook to Attach to E-Mail

MailDoc.savemessageonsend = True
    attachment1 = "c:\Dreams IO.xls" 'Required File Name

If attachment1 <> "" Then
    On Error Resume Next
        Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
        Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", "c:\Dreams IO.xls", "")
    On Error Resume Next
End If

MailDoc.PostedDate = Now()
    On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient

Set Maildb = Nothing
    Set MailDoc = Nothing
        Set AttachME = Nothing
    Set Session = Nothing
Set EmbedObj1 = Nothing

'   Routine to Generate a copy if required

Application.Run "Protect"

OnOff = MsgBox("Do you want to save a copy?", vbYesNo + vbInformation, "Save Copy?")

Select Case OnOff
    Case vbNo
        ActiveWorkbook.Close
    Exit Sub
End Select
    
Select Case OnOff
    Case vbYes
        Set NewBook = ActiveWorkbook
            Do
                fName = Application.GetSaveAsFilename
            Loop Until fName <> False
        NewBook.SaveAs Filename:=fName
    ActiveWorkbook.Close

End Select

 Exit Sub

errorhandler1:

Set Maildb = Nothing
    Set MailDoc = Nothing
        Set AttachME = Nothing
    Set Session = Nothing
Set EmbedObj1 = Nothing

End Select

End Sub