Macro Help – Saving File Name as Text found

Hello.  (using word and excel 2010) I am working off of microsoft word and right now, my code is used to:

1) Separate mail merged pages, remove the section breaks, and set default values (font, paragraph spacing).

2) Save each Separate page as a separate file. (only saves as numbers).

What I am trying to do is fix the saving part.  I want to make it so the macro finds the line with the word “To:”, and save the file name as different words on that line, for example, the line would be:

To:  Mr Jacob A Compton

I would want to save the file name as Mr Jacob Jacob A Compton.

How do I get this to work?  Thank you for your help.


Option Explicit

Sub DeleSectionBreaks()
With Selection.Find
.Text = “^b”
.Replacement.Text = “”
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub DefaultSettings()
    Selection.Font.Name = “Courier New”
    Selection.Font.Size = 12
    With Selection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .WordWrap = True
        End With
    With Selection.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(1.2)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(1)
        .RightMargin = InchesToPoints(1)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(8.5)
        .PageHeight = InchesToPoints(11)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
        .LayoutMode = wdLayoutModeDefault
    End With
End Sub
Sub AllSectionsToSubDoc()
    Dim x               As Long
    Dim Sections        As Long
    Dim Doc             As Document
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set Doc = ActiveDocument
    Sections = Doc.Sections.Count
    For x = Sections – 1 To 1 Step -1
        Call DeleSectionBreaks
        Call DefaultSettings
        ActiveDocument.SaveAs (Doc.Path & “” & x & “.doc”)
        ActiveDocument.Close False
    Next x
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub





By: Jacob Compton

Leave a Reply

Your email address will not be published. Required fields are marked *