Write From Outlook To Word
As a followup to what I originally posted, with the help of the Word
newsgroup, I was able to get a good working code.
I've pasted the completed, working code below for anyone who is interested.
Note that for it to work you'll need a subfolder of your inbox named
"holditems". Otherwise, you'll have to adjust the code for the folders of
your choice. This of course could be further adapted to using items selected
with the mouse in any folder, not just one. I only did it this way to
satisfy my immediate need.
Also, I was not able to solve the problem with additional instances of Word
remaining open. To work around this, I substituted getObject for
createObject. This works but requires Word to be open with the intended
active document already loaded.
Ron Miller
Sub outlook_to_Word()
Dim MyOLApp
Dim CC As Document
Dim MyNamespace
Dim MyOutlookToday
Dim MyInbox
Dim objDoc As Word.Application
Dim MySubFolder
Dim ItemNumber
Dim objWordDoc
Dim myRange As Range
Set MyOLApp = CreateObject("Outlook.Application")
Set MyNamespace = MyOLApp.GetNamespace("MAPI")
Set MyOutlookToday = MyNamespace.Folders("Personal Folders")
Set MyInbox = MyOutlookToday.Folders("Inbox")
Set MySubFolder = MyInbox.Folders("HoldItems")
'Set objDoc = CreateObject("Word.Application")
Set objDoc = GetObject(, "Word.Application")
ItemNumber = 0
Set CC = ActiveDocument
Set myRange = Documents(CC.Name).Range
'set range to end of doc
myRange.Collapse wdCollpaseEnd
Do
ItemNumber = ItemNumber + 1
myRange.Text = MySubFolder.Items(ItemNumber).Subject & vbCr
'Format the range
myRange.Bold = True
myRange.Font.Size = 16
myRange.Collapse wdCollapseEnd
'proceed to the next set of text, all formatted the same
myRange.Text = MySubFolder.Items(ItemNumber).SenderName & vbCr & _
MySubFolder.Items(ItemNumber).Body & vbCr & vbCr & vbCr
myRange.Bold = False
myRange.Font.Size = 12
myRange.Collapse wdCollapseEnd
myRange.InsertBreak Type:=wdPageBreak
Loop Until ItemNumber = MySubFolder.Items.Count
'objDoc.Quit
Set objDoc = Nothing
Exit Sub
errorhandler:
MsgBox "An error occurred"
'objDoc.Quit
Set objDoc = Nothing
End Sub
Quote:
> Thanks Eric,
> Posting to the Word group is what I'll do.
> Ron Miller
> > Even though you are controlling Word from Outlook, your issue is with
Word
> > VBA, specifically the Range object. You should probably repost to the
> Word
> > newsgroup.
> > You might want to include 'Set objDoc = Nothing' at the end of your
code;
> > that might prevent duplicate instances of WINWORD.EXE.
> > --
> > Eric Legault, MCSD
> > ADAPSYS - http://www.adapsys.ca
> > > I forgot to mention that I'm also using Outlook 2000. Outlook is the
> > > controlling document for the code below which is why I posted this to
an
> > > Outlook newsgroup and not a Word newsgroup.
> > > > Hi,
> > > > I have two questions that I'm asking for help in resolving. I'm
using
> > > Word
> > > > 2000 on Windows XP.
> > > > First, I am trying to write the subject, sender name and body of
> emails
> > in
> > > a
> > > > specific subfolder to the active Word document. The code below
works
> > > quite
> > > > well except for a formatting problem. I am trying to bold and set
the
> > font
> > > > to size 16 only for each subject that gets written but I want the
rest
> > of
> > > > the text to not be bolded and size 12. I want this to happen for
each
> > > email
> > > > that gets written in succession in the Word document. What is
> happening
> > is
> > > > everything is bolded and size 16.
> > > > Second, I seem to be having a problem with Word not always getting
> shut
> > > > down, presumably happening when an error occurs. I'd appreciate any
> > > > comments or suggestions on why this would be occurring or how to
> resolve
> > > it.
> > > > When I ctrl-alt-delete to bring up the Windows Task Manager, I
> sometimes
> > > > find numerous instances of Word running.
> > > > Thanks for you help,
> > > > Ron Miller
> > > > Sub outlook_to_Word()
> > > > Dim MyOLApp
> > > > Dim CC As Document
> > > > Dim MyNamespace
> > > > Dim MyOutlookToday
> > > > Dim MyInbox
> > > > Dim MySubFolder
> > > > Dim ItemNumber
> > > > Dim objWordDoc
> > > > Dim myrange As Range
> > > > Set MyOLApp = CreateObject("Outlook.Application")
> > > > Set MyNamespace = MyOLApp.GetNamespace("MAPI")
> > > > Set MyOutlookToday = MyNamespace.Folders("Personal Folders")
> > > > Set MyInbox = MyOutlookToday.Folders("Inbox")
> > > > Set MySubFolder = MyInbox.Folders("HoldItems")
> > > > Set objdoc = CreateObject("Word.Application")
> > > > ItemNumber = 0
> > > > Set CC = ActiveDocument
> > > > Set myrange = CC.Range(Start:=CC.Content.Start,
> End:=CC.Content.End)
> > > > myrange.Bold = False
> > > > myrange.Font.Size = 12
> > > > Do
> > > > ItemNumber = ItemNumber + 1
> > > > Set myrange =
> > > > Documents(CC.Name).Range(Start:=Documents(CC.Name).Content.Start,
> > > > End:=Documents(CC.Name).Content.End)
> > > > myrange.InsertAfter MySubFolder.Items(ItemNumber).Subject
> > > > myrange.Bold = True
> > > > myrange.Font.Size = 16
> > > > CC.Range.InsertParagraphAfter
> > > > myrange.SetRange Start:=Documents(CC.Name).Content.End,
> > > > End:=Documents(CC.Name).Content.End
> > > > myrange.Bold = False
> > > > myrange.Font.Size = 12
> > > > myrange.InsertAfter MySubFolder.Items(ItemNumber).SenderName
> > > > CC.Range.InsertParagraphAfter
> > > > myrange.SetRange Start:=Documents(CC.Name).Content.End,
> > > > End:=Documents(CC.Name).Content.End
> > > > myrange.Bold = False
> > > > myrange.Font.Size = 12
> > > > myrange.InsertAfter MySubFolder.Items(ItemNumber).Body
> > > > CC.Range.InsertParagraphAfter
> > > > myrange.InsertAfter
"==========================================================================
"
Quote:
> > > > CC.Range.InsertParagraphAfter
> > > > CC.Range.InsertParagraphAfter
> > > > counter = counter + 1
> > > > Loop Until ItemNumber = MySubFolder.Items.Count
> > > > objdoc.Quit
> > > > End Sub
