Batch Process Word Documents

[kerl]

I'm trying to batch process all the word documents in a specific folder (and sub folders). I've a code (thanks to a great friend) which can remove the image on the cover page & all headers/footers through out the document. It works great when its only 1 document.

I found the KB article which explains how to batch process. Now here are my problems:

1. I tried integrating my sub macro (which does the job) in the batch macro, it seems to be working except that it gets stuck at Sub SearchSubFolders(strStartPath As String) which means it cannot look beyond the main folder.

2. I'm trying to delete all images from the document. My existing code only check for the image on the first page and deletes it, also fails if there is no image! How can I modify it to delete all images if any exists and not fail where there is no image.

3. Any code to ensure sure track changes is turned off (and all changes have been accepted) before the macro starts batch processsing?

THANKS!

[kerl]

.

[Ebrow]

Hi. You were not telling your code to change to the next folder.

ps. You don't need to put scrFolder in your For each statement. The subobject is always taken, therefore I have used f :-)

Here you go, this should work for you:

Sub SearchSubFolders(strStartPath As String)

'starts at path strStartPath and traverses its subfolders and files
'if there are files below it calls OpenAllFiles, which opens them one by one
'once its checked for files, it calls itself to check for subfolders.

Set scrFso = CreateObject("scripting.filesystemobject")
Set scrFolder = scrFso.getfolder(strStartPath)
Set scrSubFolders = scrFolder.subfolders
For Each f In scrSubFolders
MsgBox f.Name
Set scrFiles = f.Files
' If scrFiles.Count > 0 Then OpenAllFiles scrFolder.Path 'if there are files below, call openFiles to open them
SearchSubFolders f.Path 'call ourselves to see if there are subfolders below
Next

End Sub

I will look into the other questions for you :-)

[kerl]

Thanks ebrow! I tried with the following and it gave me an error. How should I define f? I tried doing it as integer, object and variant - nothing worked !

Sub SearchSubFolders(strStartPath As String)

'starts at path strStartPath and traverses its subfolders and files
'if there are files below it calls OpenAllFiles, which opens them one by one
'once its checked for files, it calls itself to check for subfolders.

If scrFso Is Nothing Then Set scrFso = CreateObject("scripting.filesystemobject")
Set scrFolder = scrFso.getfolder(strStartPath)
Set scrSubFolders = scrFolder.subfolders
For Each f In scrSubFolders
MsgBox f.Name
Set scrFiles = f.Files
' If scrFiles.Count > 0 Then OpenAllFiles scrFolder.Path 'if there are files below, call openFiles to open them
SearchSubFolders f.Path 'call ourselves to see if there are subfolders below
Next

End Sub

[Ebrow]

mmm. The old Option Explicit problem. Try making it an Object.

I ran this through VBA Excel and it works.

[Ebrow]

Hi.

This sounds silly but this works for me:-

add the line

Set f = scrFso.getfolder("C:\")

after your other to set's.

It works then if you declare f as object.

[kerl]

Here's what I did -

Sub SearchSubFolders(strStartPath As String)

'starts at path strStartPath and traverses its subfolders and files
'if there are files below it calls OpenAllFiles, which opens them one by one
'once its checked for files, it calls itself to check for subfolders.
Dim f As Object

If scrFso Is Nothing Then Set scrFso = CreateObject("scripting.filesystemobject")
Set scrFolder = scrFso.getfolder(strStartPath)
Set scrSubFolders = scrFolder.subfolders
Set f = scrFso.getfolder("C:\Documents and Settings\vithacker\Desktop\FS\FS\watever")
For Each f In scrSubFolders
MsgBox f.Name
Set scrFiles = f.Files
' If scrFiles.Count > 0 Then OpenAllFiles scrFolder.Path 'if there are files below, call openFiles to open them
SearchSubFolders f.Path 'call ourselves to see if there are subfolders below
Next

End Sub

It still gives an exception (syntax error) and highlights

Sub SearchSubFolders(strStartPath As String)

BTW I think I managed to solve the other 2 problems, now only if this one would start working :banghead:

[Ebrow]

The only time it will give you an syntax error on that line that I can think of is that you are not passing the startstrpath into the code, which I think you are.

mmm. I will go andthink about it.

[fumei]

I would like to try and help, but looking at the code window is too annoying.

Please use the underscore character to break up your lines.

[kerl]

Sorry I'm a newbie to VB.....I've tried to add the file in a zip. Let me know if that helps!

[fumei]

No, no. I am talking about using the underscore character HERE, in the the code window here. This applies to Ebrow as well.

OK. I got your file. Interesting that you posted it as a .BAS file. Not a problem, it is just that most people do not.

Could you re-iterate precisely your objective?

I have to state that the logic:If secTemp.Headers(wdHeaderFooterPrimary).Exists = Trueis flawed.

Primary always exists.

Further, the whole line is:

If _
secTemp.Headers(wdHeaderFooterPrimary).Exists = True _
Or _
secTemp.Headers(wdHeaderFooterPrimary).Exists = True Then

Ummmm, both expressions in the Or are the same. So, ummm, why is there an OR?

Further, .Exists used for Section.Headers(whatever) does NOT, repeat, NOT, determine if there is a value (text) for that header object. It ONLY checks to see if it is checked in Page Setup. Which is why using .Exist for Primary is pointless, as Primary always exists.

If the purpose is to remove ALL header and footer content, then:Sub RemoveHeadFoot(wdDoc As Document)
Dim oSection As Section
Dim var, var2
For Each oSection In wdDoc.Sections
For var = 1 To 3
oSection.Headers(var).Range.Delete
Next
For var2 = 1 To 3
oSection.Footers(var2).Range.Delete
Next
Next
End Subwill delete everything from all headers and footer in wdDoc.

It is not strictly needed to make a document object and pass it to the removal Sub, as using ActiveDocument will work just as well.

[kerl]

Sorry for the delay fumei, I got caught up somewhere and couldn't get back to you.

Thanks for helping me, here are my replies:



No, no. I am talking about using the underscore character HERE, in the the code window here. This applies to Ebrow as well.

OK. I got your file. Interesting that you posted it as a .BAS file. Not a problem, it is just that most people do not.

Could you re-iterate precisely your objective?


I want to traverse multiple sub folders (multiple sub levels) to find documents.



I have to state that the logic:If secTemp.Headers(wdHeaderFooterPrimary).Exists = Trueis flawed.

Primary always exists.

Further, the whole line is:

If _
secTemp.Headers(wdHeaderFooterPrimary).Exists = True _
Or _
secTemp.Headers(wdHeaderFooterPrimary).Exists = True Then

Ummmm, both expressions in the Or are the same. So, ummm, why is there an OR?


The code checks for header or the footer, whichever exists, and deletes it. It does seem to be working


Further, .Exists used for Section.Headers(whatever) does NOT, repeat, NOT, determine if there is a value (text) for that header object. It ONLY checks to see if it is checked in Page Setup. Which is why using .Exist for Primary is pointless, as Primary always exists.

If the purpose is to remove ALL header and footer content, then:Sub RemoveHeadFoot(wdDoc As Document)
Dim oSection As Section
Dim var, var2
For Each oSection In wdDoc.Sections
For var = 1 To 3
oSection.Headers(var).Range.Delete
Next
For var2 = 1 To 3
oSection.Footers(var2).Range.Delete
Next
Next
End Subwill delete everything from all headers and footer in wdDoc.

It is not strictly needed to make a document object and pass it to the removal Sub, as using ActiveDocument will work just as well.

Ah, I'm not a VBA expert. Let me give your code a try and see what it does.

My biggest problem is that I can't get the code to traverse the sub folders. It works fine for the folder I point in the code, cleans all the files as I need...but gives an error on the subfolder routine...and I jsut can't figure out why :help