Outlook body to word document

[Joey Jeff]

Hello! There are about a million references on how to send an email from a word document, but nearly none on how to create a word document from an email automatically. I need a script that, using rules on outlook, reads a certain word in the subject line, and then automatically creates a word document with that emails body. I am incredibly new at macros and have no idea how to do this, so if you can spare a little extra time on how the code works i would be eternally grateful. Thanks!

 

[Forum Admin]

You either need to use a run a script rule to copy the mail body or save the message as a docx file.

This copies the body to a document

Sub SaveWord(Item As Outlook.MailItem)
   Dim oWord As Word.Application
   Set oWord = CreateObject("Word.Application")
   With oWord
     .Documents.Add
     .Selection.InsertBefore (Item.Body)
     .Visible = True
   End With

    Set oWord = Nothing
 
End Sub

This macro: http://www.slipstick.com/developer/convert-messages-rtf-format-save-doc-file-type/ - saves messages as a docx file type. It needs tweaked to work in a run a script rule though.

 

[Joey Jeff]

Thanks! Im running into a couple of issues however, it works if i change "Dim oWord As Word.Application" to "Dim oWord As Object" and i have no idea why. When it is the former i get the error "Compile Error: User Type Not Defined". Also, i am running into issues saving the document into a folder. Thanks so much for your response!

 

[Diane Poremsky]

If you don't have the Word object model set as a reference, you need to use object, not application.

What happens when you try to save the file? The save doc file type link above shows how to do it.

 

[Joey Jeff]

I had the both versions of the code "ActiveDocument.SaveAs Filename:='my path'" as well as "ActiveDocument.SaveAs 'My Path" as well as "oWord.Save as 'My Path'", and literally nothing happened. Word just opens and has the text from the email there, but it is not saved.

 

[Diane Poremsky]

use this format: oWord.SaveAs "C:\email\" & sName & ".doc", olRTF

 

[Joey Jeff]

Yeah, that didnt work either, it just opens the document with the body of the email there, and nothing happens. Also, i tried putting that line under the "with oWord" as ".SaveAs.....", and the document didnt even open at all, literally nothing happened. Thanks for helping me through this, its a bit frustrating haha

 

[Joey Jeff]

Here is my code:
Sub SaveWord(Item As Outlook.MailItem)
Dim oWord As Object
Dim sName As String
Dim dtDate As Date
Set oWord = CreateObject("Word.Application")
sName = Item.Subject
dtDate = Item.ReceivedTime
With oWord
.Documents.Add
.Selection.InsertBefore (Item.Body)
.Visible = True
End With

oWord.SaveAs "C:\test\htdocs\worddocuments" & sName & dtDate & ".doc", olRTF

Set oWord = Nothing
End Sub

 

[Diane Poremsky]

First thing off the bat - it's saving it to C:\test\htdocs, with a filename of worddocumentsNameDate.doc

I'll test it next and see if it works here.

 

[Diane Poremsky]

Oh, and you need to format the date and check the subject for illegal characters - windows won't save if the name is not valid.

Add this above the oword.saveas line then open the immediate window (on the View menu in the VB Editor) - send a tesat message so you can see what the macro is using for the name.
Debug.Print "C:\test\htdocs\worddocuments" & sName & dtDate & ".doc"

my filename was
C:\Users\dianep\Documents\print\Data Record 7/24/2014 14:42:087/24/2014 11:42:23 AM.doc

(my test message generator creates a message with a subject of "Data Record [Now]", so there are two dates in the filename, the one in the subject and one for the received time. )


I added these lines before With oWord
sName = sName & dtDate
ReplaceCharsForFileName sName, "_"

(and used C:\Users\dianep\Documents\print\" & sName & ".doc" to create the filename)

that turned my files name into
C:\Users\dianep\Documents\print\Data_Record_7_24_2014_14_48_337_24_2014_11_48_35_AM.doc

I'm, not sure why the admin is using the word object - saving the messages as rtf is all you really need to do. Well, it does include the message header - I guess that is why. You need to call more of the word object model if you want to save - the short snippet only opens the document onscreen.

Sub SaveWord(Item As Outlook.MailItem)

Dim sName As String
Dim dtDate As Date

   Item.BodyFormat = olFormatRichText
   sName = Item.Subject
   dtDate = Item.ReceivedTime
   sName = sName & dtDate
   ReplaceCharsForFileName sName, "_"

Debug.Print "C:\Users\dianep\Documents\print\" & sName & ".doc"
Item.SaveAs "C:\Users\dianep\Documents\print\" & sName & ".doc", olRTF

End Sub


Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
  sName = Replace(sName, "&", sChr)
  sName = Replace(sName, "%", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, " ", sChr)
  sName = Replace(sName, "{", sChr)
  sName = Replace(sName, "[", sChr)
  sName = Replace(sName, "]", sChr)
  sName = Replace(sName, "}", sChr)
End Sub

 

[Diane Poremsky]

This version saves just the body, not the header block, but it looks like sh** if the message has HTML links.

Sub SaveWord(Item As Outlook.MailItem)

Dim oWord As Object
Dim sName As String
Dim dtDate As Date
sName = Item.Subject
dtDate = Item.ReceivedTime

   sName = sName & dtDate
   ReplaceCharsForFileName sName, "_"
  
Debug.Print sName

Set oWord = CreateObject("Word.Application")

With oWord
.Documents.Add
.Selection.InsertBefore (Item.Body)
.Visible = True
End With

Debug.Print "C:\Users\dianep\Documents\print\" & sName & ".docx"

oWord.activedocument.SaveAs2 FileName:="C:\Users\dianep\Documents\print\" & sName & ".docx", FileFormat:= _
        wdFormatXMLDocument, CompatibilityMode:=15

Set oWord = Nothing

End Sub


Private Sub ReplaceCharsForFileName(sName As String, sChr As String)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
  sName = Replace(sName, "&", sChr)
  sName = Replace(sName, "%", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, " ", sChr)
  sName = Replace(sName, "{", sChr)
  sName = Replace(sName, "[", sChr)
  sName = Replace(sName, "]", sChr)
  sName = Replace(sName, "}", sChr)
End Sub

 

[Joey Jeff]

Yes that was it! Thanks sooo much!!