Hi Everyone,

I have posted this question already in the group with no results.
Now, I have done some of the macro but please help me on what is
missing. Thank you in advance.

I have an excel sheet in which it has a column full of paths of Word
files of which some are big in size due to the embeded images it
contains (mostly done through insertPicturefrom file). Can someone
please help me make a macro which would go through all the files one by
one, check for photos, if found delete them or unembed them and then
save changes.


CELL B1 CONTAINS THE DIRECTORY PATH AND COLUMN B (FROM ROW 4) CONTAINS
FILE NAMES

----------------Code Start------------------------------------

Dim WordApp As Word.Application
Set WordApp = New Word.Application
WordApp.Visible = False

For Each nDocFile In Range("B4:B" & FindLastRow("B4")).Cells
sDoc = Range("B1").Value & Application.PathSeperator &
nDocFile.Value
nDocFile.Select

WordApp.Documents.Open (sDoc)

'WHAT SHOULD I CODE HERE???

WordApp.Documents.Close savechanges:=True

Next

WordApp.Quit
Set WordApp = Nothing

------------------------CODE
ENDS------------------------------------------

RosH,
I'm no Word expert, but something like:
'To make it easier, you also need a
Dim WordDoc As Word.Document
.....
Set WordDoc=WordApp.Documents.Open (sDoc)
'Don't know if this error if Word is hidden
'Otherwise use this (or you have non-picture shapes)
'For Each MyPicture in WordDoc.Shapes
WordDoc.Shapes.SelectAll
WordDoc.Selection.Delete
WordDoc.Close savechanges:=True
......

NickHK

"RosH" wrote in message
ups.com...
Hi Everyone,

I have posted this question already in the group with no results.
Now, I have done some of the macro but please help me on what is
missing. Thank you in advance.

I have an excel sheet in which it has a column full of paths of Word
files of which some are big in size due to the embeded images it
contains (mostly done through insertPicturefrom file). Can someone
please help me make a macro which would go through all the files one by
one, check for photos, if found delete them or unembed them and then
save changes.


CELL B1 CONTAINS THE DIRECTORY PATH AND COLUMN B (FROM ROW 4) CONTAINS
FILE NAMES

----------------Code Start------------------------------------

Dim WordApp As Word.Application
Set WordApp = New Word.Application
WordApp.Visible = False

For Each nDocFile In Range("B4:B" & FindLastRow("B4")).Cells
sDoc = Range("B1").Value & Application.PathSeperator &
nDocFile.Value
nDocFile.Select

WordApp.Documents.Open (sDoc)

'WHAT SHOULD I CODE HERE???

WordApp.Documents.Close savechanges:=True

Next

WordApp.Quit
Set WordApp = Nothing

------------------------CODE
ENDS------------------------------------------