Need header and footer information

[BoatwrenchV8]

Hello,

I have a large collection of word files that have number format file names. Sorting thru them all to find out what they specifically referr to is going to be a nightmare. The file name does not contain any human understandable information. In each word file, the header contains a table with descriptive information and so does the footer. In the body of the document is another table with information. I do not need to extract any information from the body table. I am only interested in the header and footer tables. The number of rows in the tables in the header and footer are not always the same across different documents but are the same through out a single document.

Basically, I want to create an index of the descriptive information extracted from the files.

What I want to do:

1. Select a start directory
2. Have the macro open the first word document
3. Select the header and determine the number of rows in it
4. Copy the information (string text) one row at a time into variables (array)
5. Go to the footer and determine the number of rows there.
6. Copy the information (string text) one row at a time into variables
7. Close the word document.
8. Paste the copied data into the index document
9. Repeat steps 2 thru 8 for the rest of the documents in the directory.

What I have come up with so far:

*************************************

Sub Macro15()
'
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If

If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

If Selection.Information(wdWithInTable) Then
Selection.Tables(1).Select
MsgBox "this is the table. It has " & Selection.Information(wdMaximumNumberOfRows) _
& " rows", , "Total rows"
End If

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If

If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If

If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If

Selection.MoveDown Unit:=wdLine, Count:=1

If Selection.Information(wdWithInTable) Then
Selection.Tables(1).Select
MsgBox "this is the table. It has " & Selection.Information(wdMaximumNumberOfRows) _
& " rows", , "Total rows"


End If

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub


**************************************
The above code only determines the number of row each table has. I plan on using the number of rows to control the number of times I tab thru the tables copying the data in each row.

One problem is the footer table has a single blank line between the top of the footer and the top of the table. I do not know if all the files have just 1 blank line or not.

Isn't there an easier way to get to a table in the header and a table in the footer, extract the info, paste somewhere else, open the next one and keep going?

I feel like I am taking the great circle route and I am over complicating it. I have the algorhythm figured out. I usually use the macro recorder and then tune things up a little but this program is turning out to be a real challenge.

Please advise,

Thank you.

[macropod]

Hi BoatWrench,

Try something along the lines of the following code, which extracts the data for every table in the Section1 primary header & footer:
Sub Demo()
Dim oTbl As Table
Dim RngCel As Range
Dim TblTxt As String
Dim i As Integer
Dim j As Integer
With ActiveDocument.Sections(1)
If .Headers(wdHeaderFooterPrimary).Exists Then
For Each oTbl In .Headers(wdHeaderFooterPrimary).Range.Tables
With oTbl
For i = 1 To .Rows.Count
TblTxt = TblTxt & "|"
For j = 1 To .Columns.Count
Set RngCel = .Cell(i, j).Range
RngCel.End = RngCel.End - 1
TblTxt = TblTxt & RngCel.Text & "|"
Next j
TblTxt = TblTxt & vbCrLf
Next i
End With
Next oTbl
End If
If .Footers(wdHeaderFooterPrimary).Exists Then
TblTxt = TblTxt & "-" & vbCrLf
For Each oTbl In .Footers(wdHeaderFooterPrimary).Range.Tables
With oTbl
For i = 1 To .Rows.Count
TblTxt = TblTxt & "|"
For j = 1 To .Columns.Count
Set RngCel = .Cell(i, j).Range
RngCel.End = RngCel.End - 1
TblTxt = TblTxt & RngCel.Text & "|"
Next j
TblTxt = TblTxt & vbCrLf
Next i
End With
Next oTbl
End If
MsgBox TblTxt
End With
End SubInstead of using an array I've used the pipe character (ie '|') as a separator for each column, the <CR> to indicate row ends and the '-' to differentiate the header & footer tables. That's because I don't know how many rows or columns your tables might have in either the header or the footer - you can always parse the delimited data later for outputting to your other file.

Another thing I haven't tried to do, though it's fairly simple, is to test each & every header or footer - you can have up to 3 of each per Section in a Word document, plus they can be linked across Sections.

[fumei]

Hi macropod. Just some comments.

"Another thing I haven't tried to do, though it's fairly simple, is to test each & every header or footer - you can have up to 3"

Not "can". There is always 3. the questions is whether they are being used, or not. Which brings me to

If .Headers(wdHeaderFooterPrimary).Exists

This is a pointless IF. It can never return False. Primary always exists. Exists is not a test of the existence of a header (or footer). Exist is a test of whether it is checked in PageSetup. The only ones that can possibly return a False are DifferentOddEven, or DifferentFirstPage.

BoatwrenchV8,

What I want to do:

1. Select a start directory
2. Have the macro open the first word document
3. Select the header and determine the number of rows in it
4. Copy the information (string text) one row at a time into variables (array)
5. Go to the footer and determine the number of rows there.
6. Copy the information (string text) one row at a time into variables
7. Close the word document.
8. Paste the copied data into the index document
9. Repeat steps 2 thru 8 for the rest of the documents in the directory.

#1 and $2. Use the Dir function to do this.

#3, 4, 5, 6 are not needed. Use objects. Similar to what macropod is doing. You do not need to count the number of rows. You do not need to put the text into variables. You do not need to copy and paste.

Demo attached. It makes a new document with the contents of the header and footer tables - by Section.

That fact that there is a blank line in the footer before the table is irrelevant, as a table object is being used. I put a blank line in one the footers to show this.

Again, use the Dir function to process through all the doc files in a folder.

NOTE: you could make a range object of each cell, then adjust the .End, as macropod does, but as this is a very common thing (getting the text of a table cell), I use a Function.
Option Explicit
Function CellText2(aCell As Cell) As String
Dim sText As String
sText = aCell.Range.Text
CellText2 = Left(sText, Len(sText) - 2)
End Function


Sub GetStuff()
Dim oTbl As Table
Dim oSection As Section
Dim oRow As Row
Dim ThisDoc As Document
Dim myIndexDoc As Document

Set ThisDoc = ActiveDocument
Set myIndexDoc = Documents.Add

For Each oSection In ThisDoc.Sections
Set oTbl = oSection.Headers(wdHeaderFooterPrimary) _
.Range.Tables(1)
For Each oRow In oTbl.Rows
myIndexDoc.Range.InsertAfter _
CellText2(oRow.Cells(1)) & _
vbCrLf
Next
Set oTbl = oSection.Footers(wdHeaderFooterPrimary) _
.Range.Tables(1)
For Each oRow In oTbl.Rows
myIndexDoc.Range.InsertAfter _
CellText2(oRow.Cells(1)) & _
vbCrLf
Next
' just to add a break between Section information
myIndexDoc.Range.InsertAfter vbCrLf
Next
End Sub
In the attached file, click "Get Stuff" on the top toolbar.

Other comments. If you are using Dir to get the files to open and process, I would suggest adding the name of each file at the top of each "chunk". So it would look like (taken from an actual test of my demo file):

Body yadda.doc Header / Footer contents

Section 1 HeaderTable – Row 1 text
Section 1 HeaderTable – Row 2 text
Section 1 HeaderTable – Row 3 text
Section 1 FooterTable Row 1 text
Section 1 FooterTable Row 2 text

Section 2 HeaderTable – Row 1 text
Section 2 HeaderTable – Row 2 text
...etc

Do you know how to use the Dir function? I did not add that part of the code, but it is not difficult to use.

Plus I made a huge assumption. The code grabs the text from the first column of the tables in the headers and footers. That may, or may not, be correct.

If you do have DifferentFirstPage, or DifferentOddEven set, this is not a problem. You simply iterate from 1 to 3 in each Section Header (or Footer), like this:
Dim j As Long

...other stuff


For Each oSection In ThisDoc.Sections
For j = 1 to 3
Set oTbl = oSection.Headers(j) _
.Range.Tables(1)
For Each oRow In oTbl.Rows
myIndexDoc.Range.InsertAfter _
CellText2(oRow.Cells(1)) & _
vbCrLf
Next
Next

....more stuff

[fumei]

Just to demonstrate Exists....

Take a look at the attached document. Notice there is NO visible header. Check Page Setup. Different First page, and Different odd even are NOT checked. Click "Demo Header Text" on the top toolbar. It executes:
Option Explicit

Sub DemoHeaders()
Dim msg As String
If ActiveDocument.Sections(1) _
.Headers(wdHeaderFooterFirstPage).Exists Then
MsgBox "First Page header set as True."
Else
msg = msg & "First Page header does NOT Exist, but " & _
"it DOES have text: " & ActiveDocument.Sections(1) _
.Headers(2).Range.Text _
& vbCrLf
End If
If ActiveDocument.Sections(1) _
.Headers(wdHeaderFooterEvenPages).Exists Then
MsgBox "Odd / Even set as True."
Else
msg = msg & "Even Page header does NOT Exist, but " & _
"it DOES have text: " & ActiveDocument.Sections(1) _
.Headers(3).Range.Text _
& vbCrLf
End If
MsgBox msg
End Sub
Notice the use of Exists. If Exists returns False (it does not "exist"), a message string is built stating it does NOT exist...but here is the text of it anyway.

That is because the header DOES exist, and further it contains actual text content.

.Exist returns the value of the checkbox in Page Setup.

All Sections have all three headers, and all three footers.

Always. They can NOT be deleted.

[BoatwrenchV8]

Thank you all for your responces! I will start playing with these, figure out what makes them tick and why they tick. I guess I really was taking the great circle route! I have read about the Dir function but am not sure how to use it. I will post again as soon as possible.

Again, thank you all very much,

Rich

[BoatwrenchV8]

The files are no longer attached to this thread but I know I did download them and dissect them. Forgot how it worked! Been a while since I had to deal with this issues. Dusting off brain cells. Some of this can be used to help with my posting at http://www.vbaexpress.com/forum/showthread.php?t=41783