VBA to convert word into pdf and copy table to outlook body in a prescribed format

[Prince027]

Hello Experts,

Looking for a VB script for the below requirements:
1. Convert word document into pdf and attach to the email
2. Copy few sections from the word document (table) to body of the email in a prescribed format (shown in output file)
3. Except highlighted section in red, rest of the sections to be copied to email body

Note: I have attached sample input file and output file.

Body of the email should be as per the output file.

Appreciate your help. Thank for your support in advance.

[Aussiebear]

Welcome to VBAX Prince027. Th efolowwing should convert word document to PDF format

Sub ConvertWordDocxToPDF()
'Define variable fields
Dim sFolderPath As String
Dim sFileName As String
Dim sNewFileName As String
'Check if Folder Exists
sFolderPath = ActiveDocument.Path & "\"
'Set New File Name
sFileName = ActiveDocument.Name
sNewFileName = VBA.Mid(sFileName, 1, VBA.InStrRev(sFileName, ".", , vbTextCompare) - 1)
sNewFileName = sFolderPath & sNewFileName & ".pdf"
'Save File
ActiveDocument.ExportAsFixedFormat OutputFileName:=sNewFileName, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False 
End Sub

[Aussiebear]

The following should attach your document to Outlook Express

Option Explicit 
 
Sub eMailActiveDocument() 
Dim OL  As Object 
Dim EmailItem  As Object 
Dim Doc  As Document 
Application.ScreenUpdating = False 
Set OL = CreateObject("Outlook.Application") 
Set EmailItem = OL.CreateItem(olMailItem) 
Set Doc = ActiveDocument 
Doc.Save 
With EmailItem 
     .Subject = "Insert Subject Here" 
     .Body = "Insert message here" & vbCrLf & _ 
     "Line 2" & vbCrLf & _ 
     "Line 3" 
     .To = "User@Domain.Com" 
     .Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
     .Attachments.Add Doc.FullName 
     .Send 
End With 
Application.ScreenUpdating = True 
Set Doc = Nothing 
Set OL = Nothing 
Set EmailItem = Nothing 
End Sub

[Prince027]

Firstly, Thank you so much for the above codes: However,

1. In the email instead of PDF, word document is getting attached
2. From the above actual ask Point number 2 & 3 are my main requirements where i'm having difficulty
(2. Copy few sections from the word document (table) to body of the email in a prescribed format (shown in output file))
(3. Except highlighted section in red, rest of the sections to be copied to email body)

Request your help/expertise on the same.

Thank you in advance for your support.

[jdelano]

I helped a person on another site copy objects from Excel into an email in Outlook, you need to access the Word document part of the email in order to add such objects. The is the code I gave them, maybe it'll help you.

    On Error GoTo ErrorHandler


    ' setup your objects
    Dim charts As ChartObjects
    Dim chrt As ChartObject

    Dim olApp As Outlook.Application
    Dim olMail As Outlook.MailItem
    Dim olInspector As Outlook.Inspector

    Dim olEditor As Word.Document
    Dim wdRange As Word.Range

    Dim chartCount As Integer

    ' assign the values
    Set charts = Sheet1.ChartObjects

    Set olApp = New Outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)

    ' create an email in outlook
    chartCount = 1
    With olMail

        .To = "[**** TO EMAIL HERE ***]"
        .Subject = "Sending Charts"
        .Display

        Set olInspector = .GetInspector
        Set olEditor = olInspector.WordEditor
        Set wdRange = olEditor.Range(0, olEditor.Characters.Count)
        wdRange.InsertAfter "This email contains the charts you requested" & vbCr

        ' add each chart on the sheet to the outlook email
        For Each chrt In charts
            chrt.Copy

            wdRange.InsertParagraphAfter
            olEditor.Paragraphs(chartCount + 1).Range.Paste

            chartCount = chartCount + 1
        Next chrt
    End With

    olMail.Send
    olApp.Session.SendAndReceive True

    ' close outlook and clean up the objects
    'olApp.Quit

    Set olInspector = Nothing
    Set olEditor = Nothing
    Set olMail = Nothing
    Set olApp = Nothing


    MsgBox "The email has been sent"


Exit Sub

ErrorHandler:


    MsgBox "The email could not be sent. Error: " & Error(Err.Number)

    On Error Resume Next
    If Not IsNull(olApp) Then olApp.Quit

    Set olInspector = Nothing
    Set olEditor = Nothing
    Set olMail = Nothing
    Set olApp = Nothing