Problem with Automation to control Word from PPT VBA

  • Thread starter Thread starter John Svendsen
  • Start date Start date
J

John Svendsen

Hi All,

I have a problem that is plaguing me. I need to constantly modify many
embedded Word objects in several PPT files. To do so I've put together a PPT
VBA code that does this, BUT if I have another instance of word running
(which many times I need to have) the code fails at the set command in the
code with the following error:

Run-time error '-2147220995 (800401fd)':
Method 'Object' of object 'OLEFormat' failed

I've done research on this (e.g.,
http://support.microsoft.com/default.aspx?scid=kb;en-us;189618) but no luck
if fixing this SET problem.

Can someone give me an idea of what to do?

Thanks so much, JS


Sub EmbeddedWord_Replace_All_Ask()
Dim oSlide As Slide
Dim oShape As Shape
Dim oDoc As Word.Document
Dim wdApp As Object
Dim FindText, ReplaceText As String
FindText = InputBox("Enter text to be found (to be replaced)")
ReplaceText = InputBox("Enter replacement text")
Set wdApp = CreateObject("Word.Application")
For Each oSlide In ActivePresentation.Slides
With oSlide
For Each oShape In .Shapes
If oShape.Type = msoEmbeddedOLEObject Then
If oShape.OLEFormat.ProgID = "Word.Document.8" Then
'======================================================
Set wdDoc = oShape.OLEFormat.Object '<<<=== CODE FAILS HERE
'======================================================
wdDoc.Select
With wdApp.Selection.Find
.Text = FindText
.ClearFormatting
.Replacement.Text = ReplaceText
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
wdDoc.Save
wdApp.ActiveDocument.Close wdSaveChanges = False
End If
End If
Next oShape
End With
Next oSlide
wdApp.Quit
End Sub
 
John,
Try this update code:

Sub EmbeddedWord_Replace_All_Ask()
Dim oSlide As Slide
Dim oShape As Shape
Dim oDoc As Word.Document
Dim FindText, ReplaceText As String
FindText = InputBox("Enter text to be found (to be replaced)")
ReplaceText = InputBox("Enter replacement text")

For Each oSlide In ActivePresentation.Slides
With oSlide
For Each oShape In .Shapes
If oShape.Type = msoEmbeddedOLEObject Then
If oShape.OLEFormat.ProgID = "Word.Document.8" Then
Set wdDoc = oShape.OLEFormat.Object '<<<=== CODE FAILS HERE
wdDoc.Select
With wdDoc.Application.Selection.Find
.Text = FindText
.ClearFormatting
.Replacement.Text = ReplaceText
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
wdDoc.Save
If wdDoc.Application.Documents.Count = 1 Then
wdDoc.Application.Quit
Else
wdDoc.Close False
End If
End If
End If
Next oShape
End With
Next oSlide

End Sub


--
Regards,
Shyam Pillai

Toolbox: http://skp.mvps.org/toolbox
 
Shyam,
A picky syntax question here that I have always wondered about and
figured I'd leave it up to you to decide and explain (applies to XL
and PPT etc when cross appliction. The following line

If oShape.OLEFormat.ProgID = "Word.Document.8" Then

refers to the ".8" (and is that necessary or going to break in other
versions)?

I've always dropped the ".8" and gotten away with it. Not tested in
all versions of course. BTW, feel free to tell me I've got this all
wrong here and the ".8" has nothing to do with version. Hence the
syntax question.

Brian Reilly, MVP
 
Back
Top