1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Word 2007: Split large document into individual files based on text string

Discussion in 'Business Applications' started by silvasn, Mar 30, 2012.

Thread Status:
Not open for further replies.
  1. silvasn

    silvasn Thread Starter

    Joined:
    Mar 30, 2012
    Messages:
    1
    Hello all,
    I am fairly new to macros and am looking to split a large word document into smaller files based on a text string within the document, and then save those files as individual word documents, or as a bonus, PDF documents. The text string is "HEADER DATA".

    Basically, I want the macro to find the text string "HEADER DATA", then select that page and all pages up to but not including the next instance of "HEADER DATA", then cut those pages from the original document, create a new document with the same formatting/ page layout, and save that document with a new file name. I want the process repeated until the end of the document, and each file saved with a new file name.

    Some attributes about the file:

    The text string "HEADER DATA" is always in the same location on a page, but is not at the top of the page.
    The format and layout of the new document must match the current document.

    Here is something I came up with (don't laugh too hard, lol). This will extract the first pages as intended, and saves the new file, but then Word stops responding. I don't quite know what the error is. Thank you in advance for any help.

    _______________________________________________________________________________________
    Sub SPLIT()
    '
    ' SPLIT Macro
    '
    '
    vPath = ActiveDocument.Path & "\"

    Selection.Find.ClearFormatting
    With Selection.Find
    .Text = "HEADER DATA"
    .Forward = True
    .Wrap = wdFindContinue
    vFirstRecord = True
    i = 1
    End With
    Selection.Find.Execute
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=22
    Selection.MoveUp Unit:=wdScreen, Count:=5, Extend:=wdExtend
    Selection.Cut
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
    Selection.Font.Name = "Courier New"
    Selection.Font.Size = 9
    WordBasic.TogglePortrait Tab:=3, PaperSize:=0, TopMargin:="1", _
    BottomMargin:="1", LeftMargin:="1", RightMargin:="1", Gutter:="0", _
    PageWidth:="11", PageHeight:="8.5", Orientation:=1, FirstPage:=0, _
    OtherPages:=0, VertAlign:=0, ApplyPropsTo:=0, FacingPages:=0, _
    HeaderDistance:="0.5", FooterDistance:="0.5", SectionStart:=2, _
    OddAndEvenPages:=0, DifferentFirstPage:=0, Endnotes:=0, LineNum:=0, _
    StartingNum:=1, FromText:=wdAutoPosition, CountBy:=0, NumMode:=0, _
    TwoOnOne:=0, GutterPosition:=0, LayoutMode:=0, CharsLine:=39, LinesPage:= _
    36, CharPitch:=240, LinePitch:=360, DocFontName:="Times New Roman", _
    DocFontSize:=12, PageColumns:=1, TextFlow:=0, FirstPageOnLeft:=0, _
    SectionType:=1, FolioPrint:=0, ReverseFolio:=0, FolioPages:=1
    With Selection.PageSetup
    .LineNumbering.Active = False
    .Orientation = wdOrientLandscape
    .TopMargin = InchesToPoints(0)
    .BottomMargin = InchesToPoints(0)
    .LeftMargin = InchesToPoints(0.5)
    .RightMargin = InchesToPoints(0.5)
    .Gutter = InchesToPoints(0)
    .HeaderDistance = InchesToPoints(0.5)
    .FooterDistance = InchesToPoints(0.5)
    .PageWidth = InchesToPoints(11)
    .PageHeight = InchesToPoints(8.5)
    .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
    Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)
    Selection.TypeBackspace
    ActiveDocument.SaveAs (vPath & vFrom & "_" & i & ".docx")
    i = i + 1
    ActiveDocument.Close
    vFirstRecord = True
    Do
    Loop
    End Sub
    _______________________________________________________________________________________

    I've done a bit of searching on this subject, and came up with a thread on this forum from a few years ago where someone made a similar request, but that person also needed to replace the "@" symbol throughout the file with a "_", which added some lines in the code that are making this noob even more confused. He/ She wanted to split documents based on email addresses. Here is a link to that somewhat relevant thread:
    http://forums.techguy.org/business-applications/790015-solved-separate-huge-doc-file.html

    Again, any help is greatly appreciated. Thank you.
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1047211

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice