VBA to Split Document Problems

[EdHunter]

I have written the VBA code below to automate splitting and mail-merged letter into individual letters and naming each by whatever the first sentence in each newly created document is.

My problem is that at some point during the split process the font of the entire document is changed from "Ariel" to "Times New Roman"

If required i can send a "test file" to you if you would like - but i do not want to post it generally on the web as it includes company letterhead etc.

Any help would be appreciated.
Here is the code:

[vba]
Sub SplitandSave()

Dim x As Long
Dim Sections As Long
Dim Doc As Document
Dim MyName As String

On Error GoTo doh

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set Doc = ActiveDocument
Sections = Doc.Sections.Count
For x = Sections - 1 To 1 Step -1
Doc.Sections(x).Range.Copy
Documents.Add
With ActiveDocument

.Range.Paste
With .Sentences(1).TextRetrievalMode
.IncludeHiddenText = False
.IncludeFieldCodes = False
MyName = .Parent.Text
MyName = Replace(MyName, Chr(9), "")
MyName = Replace(MyName, Chr(10), "")
MyName = Replace(MyName, Chr(11), "")
MyName = Replace(MyName, Chr(12), "")
MyName = Replace(MyName, Chr(13), "")
MyName = Replace(MyName, Chr(14), "")
MyName = Replace(MyName, Chr(30), "")
MyName = Replace(MyName, Chr(160), "")
MyName = Replace(MyName, "\", "")
MyName = Replace(MyName, "/", "")
CleanString (MyName)
MyName = MyName & ".doc"
End With
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^b"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With

With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(4.2)
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1.8)
.RightMargin = CentimetersToPoints(1.8)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.25)
.FooterDistance = CentimetersToPoints(1)
.PageWidth = CentimetersToPoints(21)
.PageHeight = CentimetersToPoints(29.7)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
'the following three lines were meant to eliminate blank pages at end of Doc but just end up deleting whole doc
'To be looked at later
'Selection.GoTo 1, -1
'Selection.Bookmarks("\Page").Range.Delete
'Selection.Paragraphs.Last.Range.Delete

.SaveAs FileName:=MyName
ActiveDocument.Close False
End With
Next x
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

doh:
MsgBox "Please retry splitting the letters - IF problems persist please speak to Richard Hill"

End Sub
[/vba]

[dansyoz]

Just to clarify when you say

My problem is that at some point during the split process the font of the entire document is changed from "Ariel" to "Times New Roman

which document changes - the source or the new document?

Secondly, what is the default font in your "normal" template when you create a document with file new?

[EdHunter]

It is the new document which changes - When stepping through the code when it first pastes into new document then it is in the correct Font - it is at somepoint after this that in changes to "Times New Roman",

My normal.dot is set up to use Arial - I have triple checked this to make certain.

I have found a "semi fix" for this - Select entire document and change font to arial (code below) the problem with this being If I use the code on a document that has a different Font in it.

[VBA]
'to be inserted just before the file is saved.
Selection.WholeStory
Selection.Font.Name = "Arial"
[/VBA]

[fumei]

Why not simply dump your contents into an explicit template with the Style you want?

[EdHunter]

Why not simply dump your contents into an explicit template with the Style you want?

I have no idea what you mean!

[fumei]

Instead of:[vba]
Documents.Add
[/vba]which uses Normal.dot

use:[vba]
Documents.Add Template:="path_to_my_template"
[/vba]which creates a document with an explicit template.

[EdHunter]

I see how you mean but the problem with that solution is that - Eventually this piece of code is going to be used across the company I work in, And different people have different levels of access to the network, therefore using an explicit template would make rollout a lot more complicated.

Also If I understand the nature of a explicit template This would also cause difficulties the same as my snippet of "workaround" code - If I wished to split a file that was written in a font other than that in the template it would change due to the template.

[fumei]

"If I wished to split a file that was written in a font other than that in the template it would change due to the template."

Yes, but is that not what you want?

"Eventually this piece of code is going to be used across the company I work in, And different people have different levels of access to the network, therefore using an explicit template would make rollout a lot more complicated."

True, but you can not get around the fact that it is also possible that people will have different font in their own Normal.dot.

[Paul_Hossler]

My problem is that at some point during the split process the font of the entire document is changed from "Ariel" to "Times New Roman"

FWIW my gut feel is that you're running out of resources, maybe because you .Add a new document inside the loop N times, and MS Word is getting confused

I've had that happen, with those symptoms, and had to restart Word and 'chunk' it through ( 1-10, exit, restart, 11-20, exit, restart, ....)

You might try

1. ActiveDocument.UndoClear which will clear the UnDo cache, and/or

2. Instead of creating a new document N times, create it once, paste the section from the 'source' doc data into it, FileSaveAs, clear it all, and then paste in the next section (Remember #1)

Paul