Solved

Use Word document as Body of e-mail

Posted on 2009-04-10
28
789 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 15
  • 13
28 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 24114949
Hi, KapTheHat.

What version of Outlook are you using?
0
 

Author Comment

by:KapTheHat
ID: 24115296
2003 and 2007. (two machines).

Kaps
0
 
LVL 76

Accepted Solution

by:
David Lee earned 250 total points
ID: 24119947
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:KapTheHat
ID: 24122069
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
ID: 31568857
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
ID: 24126408
Thanks.  Don't give the points a second thought.  I'm happy I could help.
0
 

Author Comment

by:KapTheHat
ID: 24126418
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
ID: 24126437
Pls ignore above - I was being stupid.Everything is OK.Thanks again.

Kaps
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24126451
You're welcome.
0
 

Author Comment

by:KapTheHat
ID: 24126456
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
ID: 24126467
EE's rules prohibits working on questions via email.  How about posting them here?
0
 

Author Comment

by:KapTheHat
ID: 24126486
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
ID: 24134256
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
ID: 24135389
They are blank when you receive them. I haven't checked it before they are sent. I will do. Thanks

Kaps
0
 
LVL 76

Expert Comment

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

Author Comment

by:KapTheHat
ID: 24143016
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
ID: 24146103
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
ID: 24154731
thats it - you need .Display & .send for it to work.

Thanks
Kaps
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24155628
You're welcome.
0
 

Author Comment

by:KapTheHat
ID: 24157202
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
ID: 24157628
I'll have a look.  
0
 

Author Comment

by:KapTheHat
ID: 24157637
Thanks - that's all I can ask !!!

Kaps
0
 
LVL 76

Expert Comment

by:David Lee
ID: 24175927
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
ID: 24180575
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
ID: 24180953
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
ID: 24188727
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
ID: 24189964
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
ID: 24222525
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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Welcome back!  My apologies for taking so long to write part two of this series; it's been a long time coming!  As I promised in Part 1, this article will focus on how to locate those elusive AD properties that you are searching for.  Why is this us…
Hello again, all.  For those of you that have been following along, you'll know that this is my third article on this topic (though it is not Part III).  This article is sort of remedial, and probably the topic with which I should have started the s…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

733 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