get ole objects from powerpoint

[vonclausowitz]

Hi All,

I have a powerpoint slide with embedded some ole-objects (ie. word
files).
I want a VB code to extract all these worddocs and save them under a
certain name
in a certain folder.

Anyone knows how to attchieve this?

Regards

Marco
The Netherlands

 

[vonclausowitz]

This is what I have so far but it is not satisfactory.

Sub TellAll()

Dim arrShapes As Variant
Dim iCount As Integer
Dim objWord As Word.Application
Dim objDoc As Word.Document
ReDim arrShapes(0)

Dim oSh As Shape
For Each oSh In ActiveWindow.Selection.SlideRange(1).Shapes
If oSh.Type = 7 Then
arrShapes(iCount) = oSh.Name
iCount = iCount + 1
ReDim Preserve arrShapes(iCount)
End If
Next oSh

For i = 0 To UBound(arrShapes) - 1
ActiveWindow.Selection.SlideRange.Shapes(arrShapes(i)).Copy

Set objWord = CreateObject("Word.application")
objWord.Visible = True

objWord.Documents.Add
objWord.Selection.Paste
objWord.Dialogs(wdDialogFileSaveAs).Show

objWord.Visible = True


objWord.ActiveDocument.Close
objWord.Visible = False
objWord.Quit

Set objWord = Nothing
Next i

End Sub

because I use copy to get the content of the ole into word I miss
things like header and footer.


(e-mail address removed) schreef:

 

[Brian Reilly, MVP]

I'd probably check each shape for the presence of a textframe and then
the presence of text and set a variable to the text string and change
teh text string incrementally in Word to add that string. But it would
be ugly since one would know the order to put it in Word doc, I don't
think.

Brian Reilly, MVP

 

[Steve Rindsberg]

This is what I have so far but it is not satisfactory.

Sub TryThisInstead()

Dim oSh As Shape
Dim i As Long
Dim oWdApp As Word.Application
Dim oWdDoc As Word.Document

For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count
Set oSh = ActiveWindow.Selection.SlideRange.Shapes(i)
' is it an OLE object?
If oSh.Type = msoEmbeddedOLEObject Then
' is it a Word object?
If InStr(oSh.OLEFormat.ProgID, "Word") > 0 Then
'oSh.OLEFormat.Activate
oSh.OLEFormat.Object.SaveAs ("q:\support\test.doc")
oSh.OLEFormat.Object.Application.Quit
End If
End If
Next

End Sub

 

[vonclausowitz]

Hi Steve,

Tried to run your code but I get an error on the next line:
oSh.OLEFormat.Activate

If works once but then when I try to save the next document I get the
error saying:
OLEFormat (unknown member) Invalid request: could not activate OLE
object.

If I leave this line out I get an error as well:

oSh.OLEFormat.Object.SaveAs ("c:\test.doc")
methode object of object OLE format failed

Furthermore I would like to say that I want to be able to open Word and
get the SaveAS dialog window so I can create the name and save it where
I want before closing the window and do the next....

Regards
Marco

 

[Steve Rindsberg]

Hi Steve,

Tried to run your code but I get an error on the next line:
oSh.OLEFormat.Activate

What I posted was a code fragment, intended to be included in the other code
you're using; post the entire routine as it stands now so we can have a look.

 

[vonclausowitz]

This is all I have at the moment:

Sub TryThisInstead()

Dim oSh As Shape
Dim i As Long
Dim oWdApp As Word.Application
Dim oWdDoc As Word.Document
Dim strName, sFileName As String

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
strName = objShell.SpecialFolders("MyDocuments")

If Right(strName, 1) <> "\" Then
strName = strName & "\"
End If

On Error GoTo shit
For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count
Set oSh = ActiveWindow.Selection.SlideRange.Shapes(i)
' is it an OLE object?
If oSh.Type = msoEmbeddedOLEObject Then
' is it a Word object?
If InStr(oSh.OLEFormat.ProgID, "Word") > 0 Then
'oSh.OLEFormat.Activate
'oSh.OLEFormat.Object.SaveAs ("c:\test1.doc")
sFileName = InputBox("File opslaan als ")
oSh.OLEFormat.Object.SaveAs FileName:=strName & sFileName &
".doc"
oSh.OLEFormat.Object.Application.Quit
End If
End If
Next
shit:
Resume Next

MsgBox "Aantal exports: " & i
End Sub

Regards

Marco

 

[Steve Rindsberg]

I've modified it a bit ... seems to work here:

Sub TryThisInstead()

Dim oSh As Shape
Dim i As Long
' these aren't needed
'Dim oWdApp As Word.Application
'Dim oWdDoc As Word.Document
Dim strName As String
Dim sFileName As String

' these weren't dimmed before, so gave a compiler error
Dim objFSO As Object
Dim objShell As Object

On Error GoTo ErrorHandler

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
strName = objShell.SpecialFolders("MyDocuments")

If Right(strName, 1) <> "\" Then
strName = strName & "\"
End If

For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count
Set oSh = ActiveWindow.Selection.SlideRange.Shapes(i)
' is it an OLE object?
If oSh.Type = msoEmbeddedOLEObject Then
' is it a Word object?
If InStr(oSh.OLEFormat.ProgID, "Word") > 0 Then
sFileName = InputBox("File opslaan als ")
oSh.OLEFormat.Object.SaveAs FileName:=strName & sFileName & ".doc"
oSh.OLEFormat.Object.Application.Quit
End If
End If
Next

' A bit more useful error handling for test purposes
NormalExit:
MsgBox "Aantal exports: " & i
Exit Sub

ErrorHandler:
MsgBox "ERROR: " & vbCrLf & CStr(Err.Number) & vbCrLf & Err.Description
Resume Next

End Sub

 

[vonclausowitz]

It does seem to work.

The only problem is that I get an Inputbox to name the file but I don't
see the actual file in Word so I don't know how to name it. Can't I get
Word open and use the wdDialogSaveAS?

Regards
Marco

 

[Steve Rindsberg]

It does seem to work.

The only problem is that I get an Inputbox to name the file but I don't
see the actual file in Word so I don't know how to name it. Can't I get
Word open and use the wdDialogSaveAS?

Do you mean that you want to be able to see the document in Word so you can
decide what to name it, or that you want to know the file's original name?

If the latter, then no, you can't. The document's embedded in PPT ... there's
no file as such.

If the former, I imagine so. It might be as simple as making the instance of
Word visible, or at the very least, you could save to a temp file, then
automate Word to open it and go from there.

Google "automate word" and similar terms for better instructions on automating
Word than I can come up with off top of head. <g>