RE: insert multiple documents into document retaining headers and by Chuck
Chuck
Thu Apr 07 05:53:02 CDT 2005
Not sure why the code I posted didn't work for you because it works for me.
Are you sure the code you posted below (incorporating a version of what I
posted) is actually doing what it should? For instance, is the range
collapsing properly (I notice you've put parentheses around the .Collapse
argument which may not be helpful)? If you plug in the code as I posted it
(without editing it) does it work?
In any case here's an elaboration of the code I posted. Note the extra
variables. It sets objects pointing to the source and target documents and
then loops through each header in the target to make it equal to the
corresponding header in the source. However the code I posted only takes the
headers from section 1 of the source and if you're inserting a document that
has more than one section and different headers/footers for each of its
sections, then the subsequent section headers/footers (ie sections 2+) won't
be transferred. You could write code extending what I've posted below if you
wanted to capture those possible following headers/footers from the source
doc, but it would get complicated.
There may be a better way but I really don't see why the code I posted
yesterday shouldn't work for you because like I said it works for me...
Dim rngRange As Range
Dim hdrHeader As HeaderFooter
Dim ftrFooter As HeaderFooter
Dim docSource As Document
Dim docTarget As Document
Dim i As Long
'set docTarget first so activedocument
'is not .FoundFiles(i)
Set docTarget = ActiveDocument
Set docSource = Documents.Open(.FoundFiles(i))
With docTarget
Set rngRange = .Range
With rngRange
.Collapse wdCollapseEnd
.InsertBreak _
Type:=wdSectionBreakNextPage
.Collapse wdCollapseEnd
End With
With .Sections(.Sections.Count)
For Each hdrHeader In .Headers
hdrHeader.LinkToPrevious = False
i = hdrHeader.Index
hdrHeader.Range = docSource.Sections(1).Headers(i).Range
Next hdrHeader
For Each ftrFooter In .Footers
ftrFooter.LinkToPrevious = False
i = ftrFooter.Index
ftrFooter.Range = docSource.Sections(1).Headers(i).Range
Next ftrFooter
End With
rngRange.InsertFile _
FileName:=(.FoundFiles(i)), _
ConfirmConversions:=False, _
Link:=False, _
Attachment:=False
End With
docSource.Close wdDoNotSaveChanges
"Rocco" wrote:
> hi chuck,
>
> Thanx for the fast reply, but no luck this time.
> this is the exact code :
>
> MyWrd.Documents.Open(ParResultFile).Activate()
> Dim rngRange As Range
> Dim hdrHeader As HeaderFooter
> Dim ftrFooter As HeaderFooter
> With MyWrd.FileSearch
> .NewSearch()
> .LookIn = path
> .SearchSubFolders = False
> .FileName = file
> .MatchTextExactly = True
> .FileType =
> Microsoft.Office.Core.MsoFileType.msoFileTypeWordDocuments
> If
> .Execute(SortBy:=Microsoft.Office.Core.MsoSortBy.msoSortByFileName,
> SortOrder:=Microsoft.Office.Core.MsoSortOrder.msoSortOrderAscending) > 0 Then
> MsgBox("There were " & .FoundFiles.Count & " file(s) found.")
> If AppInteractive Then
> frm1.Show()
> progressbarform1 = frm1.ProgressBar1
> progressbarform1.Maximum = (.FoundFiles.Count)
> End If
>
> For i = 1 To .FoundFiles.Count
>
> If AppInteractive Then
> frm1.Label1.Text = .FoundFiles(i)
> frm1.Label1.Update()
> progressbarform1.Value = i
> End If
> With MyWrd.ActiveDocument
> rngRange = .Range
> With rngRange
>
> .Collapse(Direction:=WdCollapseDirection.wdCollapseEnd)
> .InsertBreak(WdBreakType.wdSectionBreakNextPage)
>
> .Collapse(Direction:=WdCollapseDirection.wdCollapseEnd)
> End With
> With .Sections.Item(.Sections.Count)
> For Each hdrHeader In .Headers
> hdrHeader.LinkToPrevious = False
> Next hdrHeader
> For Each ftrFooter In .Footers
> ftrFooter.LinkToPrevious = False
> Next ftrFooter
> End With
> End With
> rngRange.InsertFile(.FoundFiles(i),
> ConfirmConversions:=False, Link:=False, Attachment:=False)
>
> Next i
> Else
> Exit Sub ' There were no files found.
> End If
> .Execute()
>
> MyWrd = Nothing
> FSO = Nothing
> End With
>
> End Sub
>
>
> Thanks for thinking along sofar ;o)
> If you have the time maybe you can come up with another sollution ?
>
>
> I hope so cause I can hear the sound of my brain crackin'
> ================================
>
>
> "Chuck" wrote:
>
> > Try replacing the InsertFile code:
> > Selection.InsertFile FileName:=(.FoundFiles(i)), _
> > ConfirmConversions:=False, Link:=False, Attachment:=False
> > Selection.InsertBreak Type:=wdsectionBreaknextpage
> > with the following (the variable declarations should go at the top of the
> > sub not in the loop of course) - it uses a range instead of selection and
> > inserts the section break and removes link to previous in the new section's
> > headers/footers before inserting the new file:
> >
> > Dim rngRange As Range
> > Dim hdrHeader As HeaderFooter
> > Dim ftrFooter As HeaderFooter
> >
> > With ActiveDocument
> > Set rngRange = .Range
> > With rngRange
> > .Collapse wdCollapseEnd
> > .InsertBreak _
> > Type:=wdSectionBreakNextPage
> > .Collapse wdCollapseEnd
> > End With
> > With .Sections(.Sections.Count)
> > For Each hdrHeader In .Headers
> > hdrHeader.LinkToPrevious = False
> > Next hdrHeader
> > For Each ftrFooter In .Footers
> > ftrFooter.LinkToPrevious = False
> > Next ftrFooter
> > End With
> > rngRange.InsertFile _
> > FileName:=(.FoundFiles(i)), _
> > ConfirmConversions:=False, _
> > Link:=False, _
> > Attachment:=False
> > End With
> >