Bulk Extract Embedded Files

[DeanH]

Word 2003 on XP
Is there a way to extract embedded files all in one go?
Like the image file extraction process described in
http://www.gmayor.com/extract_images_from_word.htm but for embedded files?
Many thanks
DeanH

[Brian]

Found the following for extracting embedded word files. Haven't tried it
though.

Sub ExtractFiles()
'
' ExtractFiles Macro
'
'
Dim shape As InlineShape
Dim folderName As String
Dim a As Document

folderName = Replace(ThisDocument.Name, ".", "_")
MkDir folderName

For Each shape In ThisDocument.InlineShapes
If (shape.Type = wdInlineShapeEmbeddedOLEObject) And
(InStr(LCase(shape.OLEFormat.IconLabel), ".doc") > 0) Then
shape.OLEFormat.Object.SaveAs (folderName & "\" &
shape.OLEFormat.IconLabel)
End If
Next shape

End Sub

Hope it helps.
--
Brian McCaffery

[DeanH]

Brian, thanks but sorry, it fails at the "End If".
"Compile error: End If without block If"

DeanH

[Doug Robbins - Word MVP]

Probably caused by line breaks inserted by the mail program.

Try

For Each shape In ThisDocument.InlineShapes

If shape.Type = wdInlineShapeEmbeddedOLEObject And _
InStr(LCase(shape.OLEFormat.IconLabel), ".doc") > 0 Then
shape.OLEFormat.Object.SaveAs (folderName & "\" & _

shape.OLEFormat.IconLabel)
End If
Next shape

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

"DeanH" <De...@discussions.microsoft.com> wrote in message
news:47889C37-5858-4C48...@microsoft.com...

[DeanH]

Doug, thanks for the input. The macro does not fail now, but it also does not
do the extraction.
I have done several tests with several different files, in different
locations, but no extraction happens :-(

DeanH

[Doug Robbins - Word MVP]

Exactly what is it that you have in the document? That macro is
specifically for in-line shapes.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

"DeanH" <De...@discussions.microsoft.com> wrote in message

news:91ABD0B3-9941-4C2C...@microsoft.com...

[DeanH]

Doug.
All the embedded file are InLine.
It appears that nothing is happening when the macro is run.
What I have checked is the following.
Run macro.
No new documents appear in the folder of the original file.
No new documents are created in the drive.
Now search turns up any file with the names of the embedded files.
I have done several tests with some old documents of mine, new documents for
testing, as well as the document that I wanted this macro for in the first
place, no extraction happens.

From the macro script I gather that the extracted files should go to the
same folder as the original document, and they are named as per the icon
display.

Any way, I have manually extractd the files I needed, but it would be nice
to get this working.
Many thanks for your perseverance.

[Doug Robbins - Word MVP]

If you toggle on the display of field codes (Alt+F9) in the document that
contains the embedded files, what do you see?

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

"DeanH" <De...@discussions.microsoft.com> wrote in message

news:FE8FD360-F54A-43FE...@microsoft.com...

[DeanH]

In the specific document that started all this, for one of the files I see
{EMBED Excel.sheet.12}

[Doug Robbins - Word MVP]

The code that Brian gave you was not appropriate for Embedded object.

The following will however copy such objects to another document:

Dim Source As Document, Target As Document
Dim rngTarget As Range
Dim i As Long
Set Source = ActiveDocument
Set Target = Documents.Add
With Source
For i = .Fields.Count To 1 Step -1
If .Fields(i).Type = wdFieldEmbed Then
.Fields(i).Copy 'Use Cut instead of Copy if you want to remove
the files from the source
Set rngTarget = Target.Range
rngTarget.Collapse wdCollapseEnd
rngTarget.Paste
Target.Range.InsertAfter vbCr
End If
Next i
End With

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

"DeanH" <De...@discussions.microsoft.com> wrote in message

news:BBFD8A7F-D53A-4076...@microsoft.com...

[DeanH]

Doug.
Thanks for that, but I don't want to transfer the embedded files into
another Word document, I want to extract them to their native format in the
folder where the original Word resides.

[Doug Robbins - Word MVP]

You cannot tell from the Embed field, what the filename was, so you are
going to have to supply it, or as in the following code, just have the files
named with a name such as Sheet & i where i is the field counter that is
being used:

Dim Source As Document
Dim xlapp As Object
Dim xlbook As Object
Dim xlSheet As Object
Dim Excelwasnotrunning As Boolean
Dim i As Long
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
Excelwasnotrunning = True
Set xlapp = CreateObject("Excel.Application")
End If

Set Source = ActiveDocument

With Source
For i = .Fields.Count To 1 Step -1
If .Fields(i).Type = wdFieldEmbed Then
.Fields(i).Copy 'Use Cut instead of Copy if you want to remove
the files from the source

With xlapp
Set xlbook = .Workbooks.Add
Set xlSheet = xlbook.Worksheets(1)
xlSheet.Paste
xlbook.SaveAs "Sheet" & i
xlbook.Close
End With

End If
Next i
End With

Set xlSheet = Nothing
Set xlbook = Nothing
If Excelwasnotrunning = True Then
xlapp.Quit
End If
Set xlapp = Nothing

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

"DeanH" <De...@discussions.microsoft.com> wrote in message

news:B4C85E8E-E1E2-4CE2...@microsoft.com...