Sunday, 29 January 2012

Sending word document data as Outlook message

The below code is used to send word document data (basically combination of images, text and graphics) in the outlook message body, this is particularly needed to send VOC survey to many customers like each mail drafted separately with rich text/HTML message content..

Modul1: Create multiple outlook e-mails (html/rich text)
Sub SendDocAsMsg()
    Dim wd As Word.Application
    Dim doc As Word.Document
    Dim itm As Outlook.MailItem
    Dim ID As String
    Dim blnWeOpenedWord As Boolean
Dim i

For i = 2 To ShtX.Cells(ShtX.Rows.Count, 1).End(xlUp).Row
    Call CreateNewWordDoc(Trim(ShtX.Cells(i, 2)))
    Set wd = CreateObject("Word.Application")
    wd.Visible = True
    Set doc = wd.Documents.Open(Filename:="D:\Automation Works\VOC\VOC Message.doc", ReadOnly:=True)
    Set itm = doc.MailEnvelope.Item

    With itm
        .SentOnBehalfOfName = "pss chennai"
        .To = Trim(ShtX.Cells(i, 1))
        .Subject = "PSS - VOC Survey (Dec'11) - Reminder"
        .Attachments.Add "D:\Automation Works\VOC\ESS VOC Survey.xls"
    End With
    doc.Close savechanges:=False
    Set doc = Nothing
    Set itm = Nothing
    Set wd = Nothing
Next i

End Sub

Modul2: Create multiple messages, addressed to each receipient
Sub CreateNewWordDoc(RecptName As String)
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim i As Integer
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    'Set wrdDoc = wrdApp.Documents.Add
    ' or
     Set wrdDoc = wrdApp.Documents.Open("D:\Automation Works\VOC\Greetings.doc")
    ' sample word operations
    With wrdDoc
            .Content.InsertBefore "Hello " & RecptName & "," & vbNewLine
        If Dir("D:\Automation Works\VOC\VOC Message.doc") <> "" Then
            Kill "D:\Automation Works\VOC\VOC Message.doc"
        End If
        .SaveAs ("D:\Automation Works\VOC\VOC Message.doc")
    End With
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub