Macro to collate pages from multiple documents

[The Cat]

Hi there,

For background: I'm a new member with some (mainly self taught) Excel VBA skills, trying to write a Word macro for the first time and would appreciate any pointers anyone could give me. Essentially I'm trying to collate all the executive summary pages from several hundred reports into one Word document.

The reports are contained in a file structure:

Customer Name>Project Number>Reports>ReportName.doc

The macro I need to write will have to:

1. Loop through all the "Customer Name" folders, delving into the "Reports" folder of each.

2. Open any Word documents in the "Reports" folder, find a page with the heading "Executive Summary", copy and paste that page (or ideally just the pictures from that page) to the first blank page in a new Word document.

3. Close the original report file and move on to the next one.

I'm ok with basic programming concepts and could do a similar thing fairly easily in Excel, but am struggling to envisage how to do this in Word (particularly locating the right page in each document to copy/paste)

Thanks for reading this. Any help will be very gratefully received.

[Frosty]

If you could do something fairly easily in Excel, I would suggest starting there. The process will be pretty much exactly the same in Word, except there are (obviously) different objects.

Document instead of Workbook
Different file extensions (for the filter of which files to open)

You'll want to start by recording a macro in Word which you use to Find your executive summary page. Or you can post a mock up of the page and people who know Word can give you additional pointers to just searching for "Executive Summary". (the find criteria will be heavily dependent on how your documents are constructed... you may be able to use styles, paragraph formatting, etc)

In general, once you get into the actual document, the process is going to go like this:

1. Find your executive summary page
2. Define the range of that page (expanding from the returned find range of the .Find object) -- Note: the actual page can be tricky, as pagination stuff typically requires use of the Selection object, something you want to try to avoid, as it will slow down your processing considerably
3. Find the .Shape or .ShapeRange within the found .Range object
4. .Copy the .Shape or .ShapeRange, and dump it into your new document.

If you're having a hard time conceptualizing it, why don't you write a mock up in Excel VBA, where you just have to copy the contents of the cell A4 from 10 workbooks into a single new workbook. Much of the code you write will be immediately portable with minor tweaks.

[Frosty]

And remember, separate your code into separate procedures!

There are many ways to do this, but you should have at least 2 procs (and maybe 3, depending on your use of the filesystem object) when you're done.

I'm thinking procedures along the lines of...
1. creating new summary doc and looping through your report docs
2. finding text in current report doc and pasting into summary doc

[macropod]

Hi The cat,

Here's something to get you started. The code uses a function to have you select a folder, then extracts the first page from all documents in that folder into the current document:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim DocTarget As Document, DocSource As Document
Dim RngSource As Range, RngTarget As Range
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set DocTarget = ActiveDocument
Set RngTarget = DocTarget.Range
RngTarget.Collapse wdCollapseEnd
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set DocSource = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With DocSource
Set RngSource = .Range(0, 0)
Set RngSource = RngSource.GoTo(What:=wdGoToPage, Name:=1)
Set RngSource = RngSource.GoTo(What:=wdGoToBookmark, Name:="\page")
RngSource.Copy
.Close SaveChanges:=False
End With
With RngTarget
.Paste
.InsertAfter vbCr
.Collapse wdCollapseEnd
End With
strFile = Dir()
Wend
Set RngSource = Nothing: Set DocSource = Nothing: Set DocTarget = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

[The Cat]

Thanks for the replies guys.

Frosty - I think that's good advice. I can get everything conceptually right in Excel (especially the looping through files bit) and then make the tweaks needed to make it work in Word. It'll be much clearer in my head once I've got the basic framework down. As you alluded to, it's my lack of familiarity with the Word object model that will cause me the most problems, but the logic should be the same in both applications.

Macropod - That's really helpful. My first quick use of your code worked a treat to pick out the first page of the documents and move them across. If I can adapt the GetFolder function to cycle through the relevant folders and change the range defining bit to pick out the executive summary, I should be able to make this work.

As Frosty suggests, I'll post a mock up of a report and if any Word experts can suggest a clever way of picking out the Executive Summary page, that would help me massively.

I'll check back in and let you know how it's going, although I'm doing this alongside other things and the Easter holidays are coming up, I may be working on this sporadically for the next couple of weeks.

Thanks again for the assistance.

[The Cat]

I've attached a mocked up report as suggested by Frosty, to better illustrate what I'm trying to do.

The page I'm trying to extract will always have Executive Summary as it's first text, always in the "un-numbered heading" style. It may be on a different page number in each report and possibly in a different section. The summary itself will sometimes be more than one page long, so ideally I'd like to copy everything down to the next section break (although getting just the first page would not be a disaster)

I should probably also mention that I'm on Word 2003 and that I've got several hundred of these to collate, so going in and reformatting each one prior to collation isn't a viable option.

Again, thanks for reading and any advice from Word VBA experts is greatly appreciated.

[Frosty]

Getting down to the next section break is actually far easier than getting just the first page. Here's some sample code... you can make the find much more robust, if you find that it is returning bad stuff. I'm just going to illustrate the difference between how I test to see if something is working, and then how to insert it into macropod's code above by converting to a function. This is why breaking it into separate functions can be so useful.

Sub SelectExecutiveSummary()
Dim rngFind As Range

Set rngFind = ActiveDocument.Content

With rngFind.Find
.ClearFormatting
.Text = "Executive Summary"
.Style = "Un-numbered heading"
.Execute
'if we found it...
If .Found Then
'then adjust the found range to the end of the section, minus the section break
rngFind.End = rngFind.Sections(1).Range.End - 1
rngFind.Select
End If
End With
End Sub
But instead of selecting it, you want to return it... so we modify the routine as follows... (of course, you can skip the first step if you're comfortable with the immediate window and know that you can type fExtractExecutiveSummary(activedocument).Select to get the same functionality)

Function fExtractExecutiveSummary(docFrom As Document) As Range
Dim rngFind As Range

Set rngFind = docFrom.Content

With rngFind.Find
.ClearFormatting
.Text = "Executive Summary"
.Style = "Un-numbered heading"
.Execute
'if we found it...
If .Found Then
'then adjust the found range to the end of the section, minus the section break
rngFind.End = rngFind.Sections(1).Range.End - 1
Set fExtractExecutiveSummary = rngFind.Duplicate
Else
Set fExtractExecutiveSummary = Nothing
End If
End With
End Function
and then, in macropod's code above, instead of this:

With DocSource
Set RngSource = .Range(0, 0)
Set RngSource = RngSource.GoTo(What:=wdGoToPage, Name:=1)
Set RngSource = RngSource.GoTo(What:=wdGoToBookmark, Name:="\page")
RngSource.Copy
.Close SaveChanges:=False
End With
You replace with this:

With DocSource
set rngSource = fExtractExecutiveSummary(DocSource)
'if we didnt find it
If rngSource is nothing then
'probably should generate a report-- this is just a mock up
debug.print "Failed to find summary in: " & .FullName & vbcr
else
rngSource.Copy
End If
.Close SaveChanges:=False
End With

[The Cat]

Thanks again Frosty, lots of stuff to get my teeth into there.

I haven't had a chance to properly assimilate all this today and feed it into what I've already coded, but I've read enough to see that it's going to be really helpful to me.

I may not get the chance to work on this for a bit, but will certainly post to let you know how I've gotten on, probably the other side of Easter.