Private Sub CommandButton1_Click()
    'Save, Print and email documents
    Dim noSession As Object, noDatabase As Object, noDocument As Object
    Dim obAttachment As Object, EmbedObject As Object
    Dim stSubject As Variant, stAttachment As String
    Dim vaRecipient As Variant
    
    'Print Document
    Shapes(1).Visible = msoFalse
    ActiveDocument.PrintOut Background:=False
    Shapes(1).Visible = msoTrue
    
    'Check if the active Document is saved or not
    Const EMBED_ATTACHMENT As Long = 1454
    Const stTitle As String = "Active Document status"
    Const stMsg As String = "The active Document must first be saved " & vbCrLf _
    & "before it can be sent as an attachment."
    
    'If the active Document has not been saved at all.
    If Len(ActiveDocument.Path) = 0 Then
        MsgBox stMsg, vbInformation, stTitle
    End If
    
    'Ask then create folder if not created
     Dim rspCreate
    If Dir("E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\", vbDirectory) = "" Then
       rspCreate = MsgBox("Directory doesn't exist, do you wish to create it?", vbYesNo)
      If rspCreate = vbYes Then
            MkDir "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
        End If
    End If
    
    'If the changes in the active Document have been saved or not.
    If ActiveDocument.Saved = False Then
        ChangeFileOpenDirectory "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
        ActiveDocument.Save
    End If
    
     'Email address where file is sent to.
    vaRecipient = "myemail@mycompany.com"
     'Get the message from the user.
    stAttachment = ActiveDocument.FullName
     'Instantiate the Lotus Notes COM's Objects.
    Set noSession = CreateObject("Notes.NotesSession")
    Set noDatabase = noSession.GETDATABASE("", "")
     'If Lotus Notes is not open then open the mail-part of it.
    If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
     'Create the e-mail and the attachment.
    Set noDocument = noDatabase.CreateDocument
    Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
    Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
    
     'Add values to the created e-mail main properties.
    With noDocument
        .Form = "Memo"
        .SendTo = vaRecipient
        .Subject = ActiveDocument.Name
        .Body = "Attached in this email is the EMS forum"
        .SaveMessageOnSend = True
    End With
    
     'Send the e-mail instantly.
    With noDocument
        .PostedDate = Now()
        .Send 0, vaRecipient
    End With
   
    'End message to users saying process was sucessful
    MsgBox "Document was emailed and printed sucessfully"
    'Release objects from the memory.
    Set EmbedObject = Nothing
    Set obAttachment = Nothing
    Set noDocument = Nothing
    Set noDatabase = Nothing
    Set noSession = Nothing

End Sub

Private Sub CommandButton1_Click()
    Dim oSection As Section
    Dim r As Range
    Dim TempDoc As Document
    Dim FirstPara As String
     
    For Each oSection In ActiveDocument.Sections
        Set r = oSection.Range
        r.End = r.End - 1
        Set TempDoc = Documents.Add
        With TempDoc
            .Range = r
            FirstPara = r.Paragraphs(1).Range.Text
            FirstPara = Left(FirstPara, Len(FirstPara) - 1)
            ChangeFileOpenDirectory "E:\Documents and Settings\" & Environ("username") & "\Desktop\EMS\"
            .SaveAs FileName:=FirstPara & ".docx"
            .Close
        End With
        Set r = Nothing
        Set TempDoc = Nothing
    Next
End Sub