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