Solved

Use Word document as Body of e-mail

Posted on 2009-04-10
28
782 Views
Last Modified: 2012-06-27
I am trying to use a word document as the subject of an e-mail. The document contains both formatted text and images.

I understand that I need to convert the document into HTML - by saving the file as HTML However I cannot get the body of the e-mail to be correct.

I get a method HTML error failed on line 35.

The images will be at the top and bottom - so I am open to the idea of creating a template if need be. Thanks

Kaps

Any ideas ? Thanks

Kaps
Private Sub Cmd_Yes_TEST_emails_Click()
 

Dim Last_Row_No As Long

Dim i As Long
 

Dim Next_Email_address As String

Dim Next_First_Name As String

Dim Doc_To_Open As String

Dim Full_Doc_Name As String

Dim Mail_Body As Variant
 

Dim wrdApp As Word.Application

Dim wrdDoc As Word.Document
 
 

Dim oEmail As MailItem
 
 

Set olApp = New Outlook.Application

Set olNs = olApp.GetNamespace("MAPI")
 

Call Set_Up_Files
 

Call Set_Up_Ranges
 

Userform1.Hide
 
 

Doc_To_Open = Sheets("Front Sheet").ComboBox2.Value
 

Last_Row_No = Sheets("Test E-mails").Range("C6").End(xlDown).Row
 
 

'Invoke the word object
 

Set wrdApp = CreateObject("Word.Application")

wrdApp.Visible = True
 

'Determine which document is required
 
 
 

Full_Doc_Name = Workbook_Path & "\" & Doc_To_Open & ".doc"
 

Set wrdDoc = wrdApp.Documents.Open(Full_Doc_Name)
 

'Turn of screen alerts
 

Application.DisplayAlerts = False
 

'Save the word file as a HTML document
 

wrdDoc.SaveAs Filename:="HTMLDoc.html", FileFormat:=wdFormatHTML
 

'Get the mail body
 

Mail_Body = wrdDoc.HTMLProject.HTMLProjectItems(1).Text
 
 

'Create the Outlook mail
 
 

For i = 6 To Last_Row_No

    

    Set oEmail = olApp.CreateItem(olMailItem)

    

    Next_Email_address = Sheets("Test E-mails").Range("C" & i).Value

    Next_First_Name = Sheets("Test E-mails").Range("B" & i).Value

    

    

    With oEmail

        .To = Next_Email_address

        .Subject = "Document.doc"

        .HTMLBody = Mail_Body

        .Send

    End With

    

    

Next i
 
 

MsgBox " Your e-mails have been sent"
 
 

Set olApp = Nothing

Set olNs = Nothing
 

Set oEmail = Nothing
 

Set wrdDoc = Nothing

Set wrdApp = Nothing
 
 

End Sub

Open in new window

0
Comment
Question by:KapTheHat
  • 15
  • 13
28 Comments
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
Hi, KapTheHat.

What version of Outlook are you using?
0
 

Author Comment

by:KapTheHat
Comment Utility
2003 and 2007. (two machines).

Kaps
0
 
LVL 76

Accepted Solution

by:
David Lee earned 250 total points
Comment Utility
The code below will work for 2007.  Not sure about 2003.  It might work if Word is set as Outlook's message editor.
Sub CreateMessageFromWordDoc()

    Const wdFormatOriginalFormatting = 16

    Dim olkMsg As Outlook.MailItem, _

        olkIns As Outlook.Inspector, _

        olkDoc As Word.Document, _

        olkSel As Word.Selection, _

        wrdApp As Word.Application, _

        wrdDoc As Word.Document, _

        wrdRng As Word.Range, _

        wrdSel As Word.Selection

    Set wrdApp = CreateObject("Word.Application")

    'Change the file name and path on the next line'

    Set wrdDoc = wrdApp.Documents.Open("C:\eeTesting\Testing.doc")

    Set wrdRng = wrdApp.ActiveDocument.Range(0, wrdDoc.Characters.Count)

    wrdRng.Select

    Set wrdSel = wrdApp.Selection

    wrdSel.Copy

    Set olkMsg = Application.CreateItem(olMailItem)

    Set olkIns = olkMsg.GetInspector

    Set olkDoc = olkIns.WordEditor

    olkDoc.Windows(1).Document.Range(0, olkDoc.Characters.Count).Select

    Set olkSel = olkDoc.Windows(1).Selection

    olkSel.PasteAndFormat Type:=wdFormatOriginalFormatting

    With olkMsg

        'Change the subject ont he following line'

        .Subject = "My Subject"

        'Change the addresses on the next three lines"

        .Recipients.Add "list@company1.com"

        .recipinets.Add "list@company2.com"

        .Recipients.Add "list@company3.com"

        .Recipients.ResolveAll

        'Change Display to Send when you are ready to put this into production'

        .Display

    End With

    Set wrdSel = Nothing

    Set wrdRng = Nothing

    Set wrdDoc = Nothing

    Set wrdApp = Nothing

    Set olkSel = Nothing

    Set olkDoc = Nothing

    Set olkIns = Nothing

    Set olkMsg = Nothing

End Sub

Open in new window

0
 

Author Comment

by:KapTheHat
Comment Utility
Thanks - will give it a go and get back to you.  If it works I also increase points to 500. Can you think of any oither way it would work for 2003 ?

Kaps
0
 

Author Closing Comment

by:KapTheHat
Comment Utility
I forgot to award you 500 points before my last post. However this is perfect !!! You are beyod the level of genius. Guru would be more appropriate if not living deity.

kaps
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
Thanks.  Don't give the points a second thought.  I'm happy I could help.
0
 

Author Comment

by:KapTheHat
Comment Utility
Actually, it has starting giving me an error - Object variable or With variable not set on the following line:-

olkDoc.Windows(1).Document.Range(0, olkDoc.Characters.Count).Select
 
Any thoughts ? Kaps
Private Sub Cmd_Yes_TEST_emails_Click()
 

Const wdFormatOriginalFormatting = 16
 

Dim Last_Row_No As Long

Dim i As Long
 

Dim Next_Email_address As String

Dim Next_First_Name As String

Dim Doc_To_Open As String

Dim Full_Doc_Name As String

Dim Mail_Body As Variant
 

Dim wrdApp As Word.Application

Dim wrdDoc As Word.Document
 

Dim wrdRng As Word.Range

Dim wrdSel As Word.Selection
 

Dim olkIns As Outlook.Inspector

Dim olkDoc As Word.Document
 

Dim olkSel As Word.Selection

Dim olkMsg As Outlook.MailItem
 

Set olApp = New Outlook.Application

Set olNs = olApp.GetNamespace("MAPI")
 

Call Set_Up_Files
 

Call Set_Up_Ranges
 

Userform1.Hide
 

'Invoke the word object
 

Set wrdApp = CreateObject("Word.Application")

wrdApp.Visible = True
 

Doc_To_Open = Sheets("Front Sheet").ComboBox2.Value
 

Last_Row_No = Sheets("Test E-mails").Range("C6").End(xlDown).Row
 

'Determine which document is required
 

Full_Doc_Name = Workbook_Path & "\" & Doc_To_Open & ".doc"
 

Set wrdDoc = wrdApp.Documents.Open(Full_Doc_Name)
 

Set wrdRng = wrdApp.ActiveDocument.Range(0, wrdDoc.Characters.Count)

wrdRng.Select

Set wrdSel = wrdApp.Selection

wrdSel.Copy
 
 
 
 
 
 
 

'Turn of screen alerts
 

Application.DisplayAlerts = False
 
 

'Create the Outlook mail
 
 

For i = 6 To Last_Row_No

    

    Set olkMsg = olApp.CreateItem(olMailItem)

    

    Set olkIns = olkMsg.GetInspector

    Set olkDoc = olkIns.WordEditor
 

    olkDoc.Windows(1).Document.Range(0, olkDoc.Characters.Count).Select

    Set olkSel = olkDoc.Windows(1).Selection

    olkSel.PasteAndFormat Type:=wdFormatOriginalFormatting

    

        

    Next_Email_address = Sheets("Test E-mails").Range("C" & i).Value

    Next_First_Name = Sheets("Test E-mails").Range("B" & i).Value

    

    

    With olkMsg

        .Recipients.Add Next_Email_address

        .Subject = "Document.doc"

        .Send

    End With

    

    Set olkMsg = Nothing

    Set olkDoc = Nothing

    Set olkIns = Nothing

    

Next i
 
 

MsgBox " Your e-mails have been sent"
 
 

Set olApp = Nothing

Set olNs = Nothing
 
 
 

Set wrdDoc = Nothing

Set wrdApp = Nothing
 

Set wrdSel = Nothing

Set wrdRng = Nothing
 
 

Application.DisplayAlerts = True
 

End Sub

Open in new window

0
 

Author Comment

by:KapTheHat
Comment Utility
Pls ignore above - I was being stupid.Everything is OK.Thanks again.

Kaps
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
You're welcome.
0
 

Author Comment

by:KapTheHat
Comment Utility
actually I reall am having one of those days. It now works but the e-mails that come through are blank. Do you have an e-mail address where i can send you the files ? thks

Kaps
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
EE's rules prohibits working on questions via email.  How about posting them here?
0
 

Author Comment

by:KapTheHat
Comment Utility
I have put everything in a zip file.  If you press the button "Generate e-maills" on the front sheet it will kick off. It uses the e-mails on the test sheet.

the e-mails are all created but I get blank e-mails in my inbox. When I ran it for the very first time it was ok. However when I edited the word document it gave blank e-mails. Thanks

Kaps
09-KapTheHat.zip
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
I ran it and the messages look fine to me.  Are they blank before they're sent or only when you receive them?
0
 

Author Comment

by:KapTheHat
Comment Utility
They are blank when you receive them. I haven't checked it before they are sent. I will do. Thanks

Kaps
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 76

Expert Comment

by:David Lee
Comment Utility
Try changing Send to Display on line 88.  Look at the items and then send them manually.
0
 

Author Comment

by:KapTheHat
Comment Utility
When I send them Manually (i.e use Displayand press send manually  then the items all appear). As soon as I switch to automatic (.send) then the items do not appear. thanks

Kaps
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
I think I ran into that once before.  Trying to remember, but I think the copy and paste only works if the item is visible onscreen.  
0
 

Author Comment

by:KapTheHat
Comment Utility
thats it - you need .Display & .send for it to work.

Thanks
Kaps
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
You're welcome.
0
 

Author Comment

by:KapTheHat
Comment Utility
Blue Devil,

   I don't suppose that you could shed any light on the following. Although RoryA did a valiant job on trying to resolve it, we couldn't get to the bottom of it. Thanks

Kaps

http://www.experts-exchange.com/Software/Office_Productivity/Q_24197735.html
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
I'll have a look.  
0
 

Author Comment

by:KapTheHat
Comment Utility
Thanks - that's all I can ask !!!

Kaps
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
I see that rorya is working on that question with you and that he's making progress.  rorya is an Excel genius, I'm not, so you're in good hands with him.  I'll keep an eye on the question to see how it goes.
0
 

Author Comment

by:KapTheHat
Comment Utility
Thks - going back to my original post, is there a way of doing a search and replace ? I have the following snippet of code. I am trying to replace the text "XXXX" in the mail template with the person's first name. thanks

Kaps
     Next_Email_address = Sheets("Front Sheet").Range("J" & i).Value

                Next_First_Name = Sheets("Front Sheet").Range("G" & i).Value

                Next_Receive_Email = Sheets("Front Sheet").Range("B" & i).Value

                Next_Member_Group = Sheets("Front Sheet").Range("C" & i).Value

            '    MsgBox i & " " & Next_First_Name & " " & Next_Member_Group & " " & Next_Receive_Email

                

                If (Next_Receive_Email = "YES") Then

                   ' MsgBox Next_Receive_Email & " " & i

                    

                    

                

                     If (Trim(UCase(Next_Member_Group)) = Trim(UCase(Doc_To_Open))) Then

                     

                           'MsgBox Next_First_Name & " " & i

                            

                            Set olkMsg = olApp.CreateItem(olMailItem)

                           

                            Set olkIns = olkMsg.GetInspector

                            Set olkDoc = olkIns.WordEditor

                            

                            Set wrdRng = wrdApp.ActiveDocument.Range(0, wrdDoc.Characters.Count)

                            

                    With wrdRng

                            .Find

                            .Text = "XXXX"

                            .Replacement.Text = Next_First_Name

                            End With

                           

                            

                            wrdRng.Select

                            Set wrdSel = wrdApp.Selection

                            wrdSel.Copy

Open in new window

0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
Assuming that "XXXX" is unique, then this will work

    objMsg.Body = Replace(objMsg.Body,"XXXX","First Name")

Change Body to HTMLBody if the message is in HTML format.
0
 

Author Comment

by:KapTheHat
Comment Utility
Thanks - I tried that but nothing was replaced. I attach the files again.can you have a look ? How do i buy you several beers btw ? Thanks

Kaps
Events-and-friends-kk.zip
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
The command is too high up in the code.  It's above the point where the body is being copied into the message.  Move this line

     olkMsg.Body = Replace(olkMsg.Body, "xxxx", Next_First_Name)

to immediately after this line

     .Subject = Sheets("Front Sheet").TextBox1.Value
0
 

Author Comment

by:KapTheHat
Comment Utility
Thanks - this caused an unexpected result - all the images were replaced by their file names.

I have thought of a safer solution - to put the changes in the word document. However having playe around with the macro recorder and edited the result, it gives an error -

thanks

Kaps
With  wrdDoc

.text =Old_First_Name

.replacement.text  = New_First_name

end with
 

Old_first_name = new_first_name

Open in new window

0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Unlike scripting languages such as C# where a semi-colon is used to indicate the end of a command, Microsoft's VBScript language relies on line breaks to determine when a command begins and ends. As you can imagine, this quickly results in messy cod…
In this article we want to have a look at the directory attributes which are used by Microsoft to store the so called Security Identifiers (SID). These SIDs plays an important role in delegating and granting permissions and in authentication of trus…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now