Help with VBA

[fumei]

Sorry, but I find it hard to believe you can not talk about why you need to use InsertFile. And if it is that constricted, and you neither appear to try and understand or work with how things work...I am not sure we can help.

"Is there a way to enable this code?"

YES! Make sure the document (not zen.doc) has the style, and bloody well apply it.

I have some serious issues with this problem. If you are inserting zen.doc into another document (as section 2), and then appear to want to print Section 2...why not simply just print zen.doc?

Back to your problem:

"Basic idea was to copy zen.doc into the original doc without it assuming original docs style."

But you are NOT copying zen.doc!!! Your "idea" is flawed. It is NOT copied. You are inserting it.

If it WAS copied then - as macropod suggests - you can retain formatting.

Or, IF the target document has the style you want, you can apply the style quite simply, as I have suggested.

If - for the reasons you can not state - your environment is so weirdly restricted that it does not allow you to use Word as it actually works, then I am afraid you are SOL. The fact of the matter is that you CAN do what you say you want. If there is no viable solution it is not a problem with VBA, it is the unknown problem that you can not talk about.

[Zack]

Make sure the document (not zen.doc) has the style, and bloody well apply it.

Oh it has the style alright.

You are inserting it.

That's right.


Why this doesn't work?

[VBA]With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With
ActiveDocument.Sections(2).Range.Style="Section2Style"[/VBA]

[fumei]

What does not work? The section does not get the style applied?

[Zack]

What does not work? The section does not get the style applied?

No.

I get the error message posted before.

[fumei]

So you get Compile error/ syntax error?

[macropod]

I am obligated to .InsertFile method for the reasons which I am not allowed to talk about.

IMHO that's crap. Do you really mean to say you can't use something like:
[VBA]Sub Demo()
Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range
'Copy the required content from the source document
'strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
.Range.Copy
.Close SaveChanges:=False
End With
With ActiveDocument
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
With Sections(2)
Set Rng = .Range
With Rng
.Collapse wdCollapseStart
'Insert the new content, retaining its formatting
.PasteAndFormat Type:=wdFormatOriginalFormatting
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub[/VBA]

[fumei]

Well I am not sure it is crap or not, but it is odd and doubtful. I mean it is possible (I suppose) that there may be company rules for copying and pasting, but it is hard to think why this would be.

That being said, your posted code is rather advanced for someone who does not know how to create and use a string variable. Besides if the environment is that restricted the OP may not be able to use it.

[Zack]

So you get Compile error/ syntax error?

Run-time error 5834

[Zack]

your posted code is rather advanced for someone who does not know how to create and use a string variable.

Very advanced. I don't even know how to use macropod's code..similar to Insert.file method..

[Zack]

IMHO that's crap. Do you really mean to say you can't use something like:
[VBA]Sub Demo()
Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range
'Copy the required content from the source document
'strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
.Range.Copy
.Close SaveChanges:=False
End With
With ActiveDocument
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
With Sections(2)
Set Rng = .Range
With Rng
.Collapse wdCollapseStart
'Insert the new content, retaining its formatting
.PasteAndFormat Type:=wdFormatOriginalFormatting
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub[/VBA]

On "With sections (2)" I get Compile error: Sub or function not defined

[macropod]

I don't know what happend with the posted code, but 'With Sections(2)' should read 'With .Sections(2)'.

[fumei]

If you are getting the run-time error it usually means you have typed something incorrectly. Post the ENTIRE code that is giving you the error. Not a part, all of it.

[Zack]

If you are getting the run-time error it usually means you have typed something incorrectly. Post the ENTIRE code that is giving you the error. Not a part, all of it.

[VBA]Sub Macropod()

Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range
'Copy the required content from the source document
strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
.Range.Copy
.Close SaveChanges:=False
End With
With ActiveDocument
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
With .Sections(2)
Set Rng = .Range
With Rng
.Collapse wdCollapseStart
'Insert the new content, retaining its formatting
.PasteAndFormat Type:=wdFormatOriginalFormatting
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub[/VBA]

Had to move ' before strFile but it works. However, section 2 uses the same header as section 1.

[VBA]With Selection
.EndKey Unit:=wdStory
.InsertBreak Type:=wdSectionBreakNextPage
.InsertFile FileName:="C:\Documents and Settings\lorien\My Documents\zen.doc", Range:=""

End With

Dim oSec As Section
Dim sPrintCode As String


For Each oSec In ActiveDocument.Sections
sPrintCode = sPrintCode & oSec.Range.Information(wdActiveEndPageNumber) & ","
Next


sPrintCode = Left(sPrintCode, Len(sPrintCode) - 1)


ActivePrinter = "Jingo2"
Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:=sPrintCode, PageType:= _
wdPrintAllPages, ManualDuplexPrint:=False, Collate:=True, Background:= _
True, PrintToFile:=False, PrintZoomColumn:=0, PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0



End Sub [/VBA]

This code deletes the header of the section 1 for the inserted file into the section 2 of the document.

Isn't there a solution to use this existing code and just make it keep the settings of the inserted file?

[macropod]

If you want to preserve each document's headers etc, then you have to include code to do that. And, if the page layouts differ, you need code for that also. For a fairly comprehensive example, try the following. If the page layouts are the same, you won't need the second sub; otherwise, use both and uncomment the 'Call' line:
[VBA]Sub ImportDocument()
Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range, HdFt As HeaderFooter, i As Long
strFile = "C:\Users\Macropod\Documents\Attachments\Faces.docx"
'strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
With ActiveDocument
'If there is more than one Section, unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact subsequent Sections
If .Sections.Count > 1 Then
With .Sections(2)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
End With
End If
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
' Unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact first Section
With .Sections(2)
'Insert the new content, retaining its formatting
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
Set Rng = .Range
Rng.Collapse wdCollapseStart
With wdDoc
.Range.Copy
Rng.PasteAndFormat Type:=wdFormatOriginalFormatting
i = .Sections.Count
'Call ReplicateLayout(wdDoc.Sections(i), ActiveDocument.Sections(i + 1))
For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With ActiveDocument.Sections(i + 1)
If .Footers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Footers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
.Close SaveChanges:=False
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub[/VBA]
[VBA]Sub ReplicateLayout(ScnIn As Section, ScnOut As Section)
'Document Body variables
Dim sPageHght As Single, sPageWdth As Single
Dim sHeaderDist As Single, sFooterDist As Single
Dim sTMargin As Single, sBMargin As Single
Dim sLMargin As Single, sRMargin As Single
Dim sGutter As Single, sGutterPos As Single
Dim lPaperSize As Long, lGutterStyle As Long
Dim lMirrorMargins As Long, lVerticalAlignment As Long
Dim lScnStart As Long, lScnDir As Long
Dim lOddEvenHdFt As Long, lDiffFirstHdFt As Long
Dim bTwoPagesOnOne As Boolean, bBkFldPrnt As Boolean
Dim bBkFldPrnShts As Boolean, bBkFldRevPrnt As Boolean
Dim bOrientation As Boolean
With ScnIn
'Populate Document Body variables
With .PageSetup
lPaperSize = .PaperSize
lGutterStyle = .GutterStyle
bOrientation = .Orientation
lMirrorMargins = .MirrorMargins
lScnStart = .SectionStart
lScnDir = .SectionDirection
lOddEvenHdFt = .OddAndEvenPagesHeaderFooter
lDiffFirstHdFt = .DifferentFirstPageHeaderFooter
lVerticalAlignment = .VerticalAlignment
sPageHght = .PageHeight
sPageWdth = .PageWidth
sTMargin = .TopMargin
sBMargin = .BottomMargin
sLMargin = .LeftMargin
sRMargin = .RightMargin
sGutter = .Gutter
sGutterPos = .GutterPos
sHeaderDist = .HeaderDistance
sFooterDist = .FooterDistance
bTwoPagesOnOne = .TwoPagesOnOne
bBkFldPrnt = .BookFoldPrinting
bBkFldPrnShts = .BookFoldPrintingSheets
bBkFldRevPrnt = .BookFoldRevPrinting
End With
End With
With ScnOut
With .PageSetup
.GutterStyle = lGutterStyle
.MirrorMargins = lMirrorMargins
.SectionStart = lScnStart
.SectionDirection = lScnDir
.OddAndEvenPagesHeaderFooter = lOddEvenHdFt
.DifferentFirstPageHeaderFooter = lDiffFirstHdFt
.VerticalAlignment = lVerticalAlignment
.PageHeight = sPageHght
.PageWidth = sPageWdth
.TopMargin = sTMargin
.BottomMargin = sBMargin
.LeftMargin = sLMargin
.RightMargin = sRMargin
.Gutter = sGutter
.GutterPos = sGutterPos
.HeaderDistance = sHeaderDist
.FooterDistance = sFooterDist
.TwoPagesOnOne = bTwoPagesOnOne
.BookFoldPrinting = bBkFldPrnt
.BookFoldPrintingSheets = bBkFldPrnShts
.BookFoldRevPrinting = bBkFldRevPrnt
.PaperSize = lPaperSize
.Orientation = bOrientation
End With
End With
End Sub[/VBA]

[fumei]

[vba]For Each oSec In ActiveDocument.Sections
sPrintCode = sPrintCode & oSec.Range.Information(wdActiveEndPageNumber) & ","
Next [/vba]Never did answer why you are doing this For Each.

The fact of the matter is that it does not matter. It is a useless piece of code...as you never actually use any difference in Sections. You only ever use the LAST one. sPrintCode only ends up with the values from the LAST Section. The For Each is totally pointless.

I just looked at your previous postings. Ah. I now recognize you.

As you - hopefully - are now seeing, your request is possible, but you are not doing yourself any favours at all by not paying attention, or giving full information. You never mentioned that you wanted to retain headers.

Good luck. Please pay attention to what macropod is posting.

[Zack]

If you want to preserve each document's headers etc, then you have to include code to do that. And, if the page layouts differ, you need code for that also. For a fairly comprehensive example, try the following. If the page layouts are the same, you won't need the second sub; otherwise, use both and uncomment the 'Call' line:
[VBA]Sub ImportDocument()
Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range, HdFt As HeaderFooter, i As Long
'strFile = "C:\Users\Macropod\Documents\Attachments\Faces.docx"
strFile = "C:\Documents and Settings\lorien\My Documents\zen.doc"
With ActiveDocument
'If there is more than one Section, unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact subsequent Sections
If .Sections.Count > 1 Then
With .Sections(2)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
End With
End If
Set Rng = .Sections(1).Range
With Rng
'If there's already a Section break, move back one character
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
'Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.MoveEnd wdCharacter, -1
.Collapse wdCollapseEnd
End With
'Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
' Unlink the headers & footers from the 1st Section
' so that the new Section's content won't impact first Section
With .Sections(2)
'Insert the new content, retaining its formatting
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
Set Rng = .Range
Rng.Collapse wdCollapseStart
With wdDoc
.Range.Copy
Rng.PasteAndFormat Type:=wdFormatOriginalFormatting
i = .Sections.Count
'Call ReplicateLayout(wdDoc.Sections(i), ActiveDocument.Sections(i + 1))
For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With ActiveDocument.Sections(i + 1)
If .Footers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Footers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
.Close SaveChanges:=False
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub[/VBA]

It keeps the section one's header..tried it several times..

[macropod]

Zack,

There is no need to quote back at people the entirety of their posts. Please don't do it. If there's a particular statement in the post you need to comment on, fine, quote that, but not the entire post.

As for the Section 1 header, are you now saying (which you've never mentioned before) that you want to replace the active document's header with the header from the inserted document?

[Zack]

As for the Section 1 header, are you now saying (which you've never mentioned before) that you want to replace the active document's header with the header from the inserted document?

No. I just don't want the inserted document to use the header of the section one.

[macropod]

Replace:

[vba] For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
%

[Zack]

Replace:

[vba] For Each HdFt In .Sections(i).Headers
With ActiveDocument.Sections(i + 1)
If .Headers(HdFt.Index).Exists Then
.Headers(HdFt.Index).Range.Copy
HdFt.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Headers(HdFt.Index).Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
%

Replace it with what?