# Outllok insert word as Message Body



## Billucky (Dec 1, 2012)

Hello there,

I have a code that sents an email to the reciepents I want, with the attachement i need

The problem is tha in the message of the mail I want after this:
*[FONT=&quot]To:  [/FONT]*<o></o>*Recipient1*
*[FONT=&quot]ATTN:  [/FONT]*<o></o>*Attn*
*[FONT=&quot]Dear  [/FONT]*<o></o>*Recipient2*


to input a message from a specific word document

So we have:

With OutMail
.To = cell.Value
.Subject = Subj
.body = "To:" & "  " & Recipient1 & "  " & vbNewLine & vbNewLine _
        & "ATTN:" & "  " & Attn & vbNewLine & vbNewLine & _
        "Dear" & "  " & Recipient2 _
 HERE THE TEXT FROM THE WORD DOCUMENT MUST BE ENTERED

Can anybody please provide some help?


----------



## strive4peace (Dec 1, 2012)

use .htmlbody instead of .body if you want to embed html in the body

what is <o></o> for ?

I am really not clear on what you are after.  Please post all the code -- and use CODE tags 

BB Code List - MrExcel Message Board


----------



## Billucky (Dec 1, 2012)

Thank you for your response.

Actually all the s <o></o> was a wrong paste
This is the code


```
Sub Send_Email_Current_Workbook()
Dim OutApp As Object
Dim OutMail As Object
Dim filepath As String
Dim Subj As String
Dim EmailAddr As String
Dim Recipient1 As String
Dim Recipient2 As String
Dim Attn As String
Dim Msg As String
Dim HLink As String
Dim Message As String
Dim atatch As String
Dim bodymsg As String
 

   For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
     Set OutApp = CreateObject("Outlook.Application")
     OutApp.Session.Logon
     Set OutMail = OutApp.CreateItem(0)


  If cell.Value Like "*@*" Then
      'Get the data
      Subj = cell.Offset(0, 3).Value
      Recipient1 = cell.Offset(0, -1).Value
      Attn = cell.Offset(0, 1).Value
      Recipient2 = cell.Offset(0, 2).Value
      Message = cell.Offset(0, 4).Value
      EmailAddr = cell.Value
      atatch = cell.Offset(0, 5).Value
     
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = Subj

.Body = ?????

 .Attachments.Add atatch
 .Display
'.Send
```


So at the .Body = ????? part i need something that retrieves all the data from a specific document (doc or rtf or html) but it has to maintain the format (colors, underlined text, bold etc.)


----------



## s.ridd (Dec 3, 2012)

This is tested with Office 2007. I've used Early Binding because it is much easier/quicker (so remember to set a reference to the Word and Outlook object models) however it could be adapted to use Late Binding (although if you do and you're testing it you may want to add a wdApp.Visible = True line incase there are any errors loading the word file)


```
Sub SendWordDoc()Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim outApp As Outlook.Application
Dim outMailItem As Outlook.MailItem
Dim strGreeting


    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Open("C:\filetobesent.docx")
    
    strGreeting = "Dear Blah," & vbNewLine
    
    wdDoc.Characters(1).InsertBefore strGreeting
    
    Set outApp = New Outlook.Application
    Set outMailItem = wdDoc.MailEnvelope.Item
    
    With outMailItem
        .To = "joe@bloggs.com"
        .Subject = "word"
        .Send
    End With
    
    outApp.Quit
    wdDoc.Close wdDoNotSaveChanges
    wdApp.Quit
    
    Set outMailItem = Nothing
    Set outApp = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing


End Sub
```

Now you just need to wrap this inside your original code.

What is it doing? Well it is opening your specified word document and then inserting your greeting/salutation before the original content. It is then setting a mailitem to that word document and giving it a recipient, subject and attachment then sending. I'd suggest testing this with the .To as your email address. Note - it will ignore any header/footers you have. If you want them (not sure why?) then you'd need to fetch those separately.

Hope this helps and let me know if you have any problems.

Simon


----------



## Billucky (Dec 4, 2012)

Dear Simon ,

Thank you very much for your help.

I have tried your code by itself and implementing to my code as well.
The same error keeps coming up

Run-Time error '-2147467259 (80004005)
Method 'MailEnvelope' of Object'_Document' Failed.

Can you understand what is the problem? (i also have Office 2007)


----------



## s.ridd (Dec 4, 2012)

Unfortunately I can't recreate the error. I know that Outlook needs to be your default mail program but beyond that I don't really know. I knocked this code up quite quickly yesterday so it could be improved, I've added in a few of those improvements quickly. The other option would be to add an introduction to the mailenvelope with a line like  
	
	
	
	
	
	



```
wdDoc.MailEnvelope.Introduction = strGreeting
```
 and then remove all other references. However this might not suit your needs and I also don't know how it would stop the problem. 

Also I googled the error (as I haven't come across it before) there doesn't seem to be much information but there is a suggestion of saving the email before sending. So I've included that option (you'll probably need to change the loop calculation which deletes out your strGreeting from the beginning).


```
Sub SendWordDoc()Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim outApp As Outlook.Application
Dim outMailItem As Outlook.MailItem
Dim strGreeting As String
Dim i As Integer
Dim bWdOpen As Boolean
Dim bOutOpen As Boolean


On Error Resume Next
    Set wdApp = New Word.Application
On Error GoTo 0


    If Not wdApp Is Nothing Then
        bWdOpen = True
    Else
        bWdOpen = False
        Set wdApp = New Word.Application
    End If
    
    Set wdDoc = wdApp.Documents.Open("C:\filetobesent.docx")
    
    strGreeting = "Dear Blah," & vbNewLine
    
    wdDoc.Characters(1).InsertBefore strGreeting
    wdDoc.Save


On Error Resume Next
    Set outApp = New Outlook.Application
On Error GoTo 0


    If Not outApp Is Nothing Then
        bOutOpen = True
    Else
        bOutOpen = False
        Set outApp = New Word.Application
    End If
    
    Set outMailItem = wdDoc.MailEnvelope.Item
    
    With outMailItem
        .To = "joe@bloggs.com"
        .Subject = "word"
        .Send
    End With
    
    For i = 1 To Len(strGreeting) - 2
        wdDoc.Characters(1).Delete
    Next i
    
    If bOutOpen = False Then outApp.Quit
    wdDoc.Close wdSaveChanges
    If bWdOpen = False Then wdApp.Quit
    
    Set outMailItem = Nothing
    Set outApp = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing


End Sub
```

Try this code and make sure Outlook 2007 is your default mail program and if it still isn't working let me know and I'll have a rethink.

Simon


----------



## Billucky (Dec 4, 2012)

Dear Simon,

Thanks again for your help.

Although I have tried everything I the above mentioned code, the same error seems to appear. 
Outlook is my default mail program (in fact the only one), maybe it has to do with the fact that although I have Offiice 2007, Outlook is 2003. I will try it again this weekend, where I will have access to another pc.

I have tried to make something else:



```
[/COLOR]
 Dim OL As Object
 Dim W As Object
 Dim MsgTxt As String, SendFile As String
 Dim ToRangeCounter As Variant
 
  


 SendFile = Application.GetOpenFilename(Title:="Select MS Word " & "file to mail, then click 'Open'", buttontext:="Send", _
     MultiSelect:=False)




 Set W = GetObject(SendFile)
 
 
 MsgTxt = W.Range(Start:=W.Paragraphs(1).Range.Start, _
 End:=W.Paragraphs(W.Paragraphs.Count).Range.End)




 Set W = Nothing

  On Error Resume Next
             With OutMail
            .To = cell.Value
            .Subject = Subj
            .Body = MsgTxt
[COLOR=#574123][code][/COLOR]

It works and i get the data from the word document, but my main problem remains.....
I keep loosing the format of the text in the word document. Maybe you have some idea of what needs to be changed in order for the data to maintain their format?

Again thanks for all your help
```


----------



## s.ridd (Dec 4, 2012)

Ah, there is the source of your problem. MailEnvelope requires that Outlook is either the same version as Word or later. So if you are using Outlook 2003 and Word 2007 then it won't work.

I'm not sure I can think of any other way of maintaining the formatting but I will put my thinking cap on and let you know either way.


Simon

P.S. I say "any other way" - you could always email the word document as an attachment?


----------



## Billucky (Dec 4, 2012)

Thanks again.

I will try it to another pc with word and oultook to be 2007. I will post back my results, even if it takes some time to do so.

P.S. Yes, i know. But actually I want the mail to have an attachement as well!! 

Billucky


----------



## s.ridd (Dec 4, 2012)

OK, after a little playing I wondered whether I could just simply copy and paste the information. I have tested tables, fonts and hyperlinks and the formatting appears to be retained. Let me know if this works for you. I had to display the windows for the paste to work but I guess that it isn't the end of the world if it flashes up for a split second. Funny how the simple answer can evade you.

Let me know how you get on


```
Sub SendWordDoc()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim outApp As Outlook.Application
Dim outMailItem As Outlook.MailItem
Dim outInsp As Outlook.Inspector
Dim strGreeting As String
Dim bWdOpen As Boolean
Dim bOutOpen As Boolean

On Error Resume Next
    Set wdApp = Word.Application
On Error GoTo 0

    If Not wdApp Is Nothing Then
        bWdOpen = True
    Else
        bWdOpen = False
        Set wdApp = New Word.Application
    End If
    
    wdApp.Visible = True
    
    Set wdDoc = wdApp.Documents.Open("C:\filetobesent.docx")
    
    strGreeting = "Dear Blah," & vbNewLine
    
    wdDoc.Characters(1).InsertBefore strGreeting

On Error Resume Next
    Set outApp = Outlook.Application
On Error GoTo 0

    If Not outApp Is Nothing Then
        bOutOpen = True
    Else
        bOutOpen = False
        Set outApp = New Outlook.Application
    End If
    
    Set outMailItem = outApp.CreateItem(olMailItem)
    Set outInsp = outMailItem.GetInspector
    
    outInsp.Display
    wdDoc.Content.Copy
    outInsp.WordEditor.Content.Paste
    
    With outMailItem
        .To = "joe@bloggs.com"
        .Subject = "word"
        .Send
    End With

    If bOutOpen = False Then outApp.Quit
    wdDoc.Close wdDoNotSaveChanges
    If bWdOpen = False Then wdApp.Quit
    
    Set outInsp = Nothing
    Set outMailItem = Nothing
    Set outApp = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing

End Sub
```

Simon


----------



## Billucky (Dec 1, 2012)

Hello there,

I have a code that sents an email to the reciepents I want, with the attachement i need

The problem is tha in the message of the mail I want after this:
*[FONT=&quot]To:  [/FONT]*<o></o>*Recipient1*
*[FONT=&quot]ATTN:  [/FONT]*<o></o>*Attn*
*[FONT=&quot]Dear  [/FONT]*<o></o>*Recipient2*


to input a message from a specific word document

So we have:

With OutMail
.To = cell.Value
.Subject = Subj
.body = "To:" & "  " & Recipient1 & "  " & vbNewLine & vbNewLine _
        & "ATTN:" & "  " & Attn & vbNewLine & vbNewLine & _
        "Dear" & "  " & Recipient2 _
 HERE THE TEXT FROM THE WORD DOCUMENT MUST BE ENTERED

Can anybody please provide some help?


----------



## strive4peace (Dec 4, 2012)

nice code, Simon

Bill, as written, you will need to reference:

Microsoft Word #.# Object Library
Microsoft Outlook #.# Object Library

'~~~~~~~~~ Compile ~~~~~~~~~

Whenever you change code, references, or switch versions or operating environment, you should always compile and save before executing.

from the menu in a VBE (module) window: Debug, Compile

Fix any errors on the yellow highlighted lines.
Add needed references and remove missing references if necessary
(Tools, References...)

keep compiling until nothing happens (this is good!) -- then Save

~~~~~ also be sure to use *Option Explicit *at the top of each module so variables that are not declared or are misspelled will be picked up

*Option Explicit* ' require variable declaration

If this was not done when other code was written, you will probably need to DIM some variables -- best to do that anyway


----------



## Billucky (Dec 8, 2012)

I have tested it in a pc that has word and outlook 2007

AND IT WORKS PERFECT.......!!!!!!!!!

Simon,  Thank you soooooo much for this.....!!!!!!
Thank you to Crystal for your efforts.


----------



## Billucky (Dec 8, 2012)

ohhhhhhhh........I cannot understand this

It worked perfectly fine for 4-5 times but now suddenlty it says

Run-Time error '91'
Object variable or with block variable not set.
For the  outInsp.WordEditor.Content.Paste part of the code.....

Can you guess whats wrong???


----------



## Billucky (Dec 8, 2012)

I restarted Outlook and it worked again perfectly!!
I dont know what was wrong...

Anyway thanks again !!!


----------



## strive4peace (Dec 8, 2012)

perhaps this:
Set wdApp = Word.Application

should be:
Set wdApp = GetObject(,"Word.Application")

Likewise with Outlook

As it is now, the current instance is not being used because the syntax is not right -- as a result, new instances are being created each time ...


----------



## s.ridd (Dec 8, 2012)

Hi Crystal,

interesting point, I think that GetObject should probably always be used when binding objects to avoid uncertainty and incorrect use. I think my code was left as it is because I copied the Word error trap for the Outlook part which I shouldn't have done (I'll explain below). As it stands the Outlook part is redundant and needs a GetObject statement to be useful.  My understanding of the Set outApp = Outlook.Application line is that it will use the active version of outlook if there is one, otherwise create its own. This can be tested with the following code


```
Sub testOut()

Dim outApp As Outlook.Application


    Set outApp = Outlook.Application
    
    MsgBox outApp.ActiveExplorer


End Sub
```

When Outlook is open this should display "Inbox" or "Drafts" or "Calendar" etc but when there isn't, it will initiate an instance of Outlook but because there is no active explorer will fail.

However, my experience with Word (2007 at least) is different in that "Set wdApp = Word.Application" does act like GetObject. For example try creating a new word document and type "Hello" (or something else) in the document then run this code from Excel


```
Sub testWd()

Dim wdApp As Word.Application


    Set wdApp = Word.Application
    
    MsgBox wdApp.ActiveDocument.Range


End Sub
```

and you should get the word "Hello" pop up, close Word and run again and this will error.

My understanding could be wrong.

Anyway, back on track, it is possible that the code is picking up the wrong inspector (although I'm not sure why it would). I would recommend, as Crystal says, definitely replacing the Set outApp = Outlook.Application with Set OutApp = GetObject(, "Outlook.Application") and doing the same for Word if you want to. If after this you still get an error then post up your full code and I/we'll take a look 

Simon


----------



## Billucky (Dec 8, 2012)

Dear Simon,

I dont know what happended with outlook but now your code works everytime i try to use it. 
Thats just perfect.

Thank you so much for that.

I wonder (if its not much to ask) if you could help with with this:

The  strGreeting is set as String

And my  strGreeting actually is


```
strGreeting = To:" & "  " & Recipient1 & "  " & vbNewLine & vbNewLine _                     & "ATTN:" & "  " & ATTN & vbNewLine & vbNewLine & _
                     "Dear" & "  " & Recipient2 & vbNewLine & vbNewLine _
[code]

Everythind is set fine like this:

To:  blahblah  
 
ATTN:  blahblahblah
 
Dear  blahblah

Is there any way to make To: and ATTN: to be [B]bold[/B]? Not their value  I have tried many things but i gues the fact that is set as string (or even HTMLtext) does not take any bold :(. Example

[B]To:[/B]  blahblah  
 
[B]ATTN:[/B]  blahblahblah
 
Dear  blahblah
```


----------



## s.ridd (Dec 8, 2012)

Hi Bill,

Please see the code below, to set up extra words to be in bold just change the BoldWords array.


```
Sub SendWordDoc()

Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdSel As Word.Selection
Dim outApp As Outlook.Application
Dim outMailItem As Outlook.MailItem
Dim outInsp As Outlook.Inspector
Dim strGreeting As String
Dim bWdOpen As Boolean
Dim bOutOpen As Boolean
Dim i As Integer
Dim BoldWords(1) As String


On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0


    If Not wdApp Is Nothing Then
        bWdOpen = True
    Else
        bWdOpen = False
        Set wdApp = New Word.Application
    End If
    
    wdApp.Visible = True
    
    Set wdDoc = wdApp.Documents.Open("C:\filetobesent.docx")
    
    strGreeting = "Dear Blah," & vbNewLine
    
    wdDoc.Characters(1).InsertBefore strGreeting
    
    Set wdSel = wdApp.Selection
    BoldWords(0) = "To"
    BoldWords(1) = "ATTN"
    
    For i = LBound(BoldWords) To UBound(BoldWords)
        With wdSel.Find
           .Replacement.Font.Bold = True
           .MatchWholeWord = True
           .Execute FindText:=BoldWords(i), ReplaceWith:=BoldWords(i), _
            Format:=True, Replace:=wdReplaceAll
        End With
    Next i
    
On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0


    If Not outApp Is Nothing Then
        bOutOpen = True
    Else
        bOutOpen = False
        Set outApp = New Outlook.Application
    End If
    
    Set outMailItem = outApp.CreateItem(olMailItem)
    Set outInsp = outMailItem.GetInspector


    outInsp.Display
    wdDoc.Content.Copy
    outInsp.WordEditor.Content.Paste


    With outMailItem
        .To = "joe@bloggs.com"
        .Subject = "word"
        .Send
    End With


    If bOutOpen = False Then outApp.Quit
    wdDoc.Close wdDoNotSaveChanges
    If bWdOpen = False Then wdApp.Quit
    
    Set outInsp = Nothing
    Set outMailItem = Nothing
    Set outApp = Nothing
    Set wdSel = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing


End Sub
```

Hope this helps

Simon


----------



## Billucky (Dec 8, 2012)

Absolutely brilliant code Simon.!!!

Thank you soooooo very much for everything.!!!!!!!!!!!!!!!


----------

