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.
Welcome to VBAX Prince027. Th efolowwing should convert word document to PDF format
Code: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
The following should attach your document to Outlook Express
Code: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
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.
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.
Code: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