View Single Post
 
Old 07-21-2019, 02:18 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,106
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Sending a document by e-mail is easy enough and has indeed been covered before, however what is the purpose of sending the document and who is it being sent to?

You say it is a 'form'. If you want it to remain as a working form there is little point sending it as the body of a message, so you should save it as a document and send the document as an attachment to a message. The following will do that and as your form should use content controls, it takes the subject from a content control titled subject. You can modify it to use more than one control for the subject if you wish.

Note the comment at the top of the macro. It won't work without that code.

To convert the form from form fields to content controls you may find Insert Content Control Add-In useful

Code:
Option Explicit

Sub Send_As_Mail_Attachment()
'Graham Mayor - https://www.gmayor.com - Last updated - 21 Jul 2019
'Send the document as an attachment in an Outlook Email message
'Requires the code from - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook if it is closed.
Dim bStarted As Boolean
Dim olApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim oDoc As Document
Dim strName As String
Dim oCC As ContentControl
Dim strSubject As String

    Set oDoc = ActiveDocument
    On Error GoTo err_Handler:
    oDoc.Save
    Set oCC = oDoc.SelectContentControlsByTitle("Subject").Item(1)
    If oCC.ShowingPlaceholderText = False Then
        strSubject = oCC.Range.Text
    Else
        strSubject = "Default subject text"
    End If
    strName = oDoc.FullName
    'Get Outlook if it's running
    Set olApp = OutlookApp()
    'Create a new mailitem
    Set oItem = olApp.CreateItem(0)

    With oItem
        .Display
        .To = "someone@somewhere.com"
        .Subject = strSubject
        .Attachments.Add strName
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        oRng.Text = "Complete the attached form and return to sender."
        '.Send 'Restore line after testing
    End With

lbl_Exit:
    Set oItem = Nothing
    Set olApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oDoc = Nothing
    Set oRng = Nothing
    Exit Sub
err_Handler:
    Err.Clear
    GoTo lbl_Exit
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote