Suggestions on how to split single doc files into multiple docs w/VBA

[kphu]

Hi Everyone,

I'm new to word VBA but been doing vba with excel and access for a long time. I was given a task and looking for suggestion on how I should code it. Here's what I need.

I have a word document that has information in it. I need to split the information by 20 line segments and place each into a new word document.

Example:

The "source" word document has 88 lines in it. I should end up with 5 word documents: 4 made up of 20 lines each and the 5th with 8 lines in it.

I was thinking about starting off by counting the number of lines within the document and dividing it by 20 so I know how many times I need to create a new document.

From there I would use the extendmode functionality to select text and copy and paste into a new word document.

Would you agree this is the best approach or a feasible approach or is there other functions that I can use?

If you were to go with the approach I'm taking what methods, properties or functions should I use?

Thanks,

Ken

 

[SkipVought]

hi,

The "source" word document has 88 lines in it.

If you search the Word Object Model, you will find no 'line' object, at least not in terms of the text in your document.

You have Paragraphs, Sentences, Words, for instance.

Since you have programmed in Excel VBA, you are familiar with the Excel Object Model. These objects and be manipulated in similar manner.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Andrzejek]

Unless every line ends with a carriage return, it will be hard to determine how many lines there are in the document. Word has a ‘word wrap’ and numbers of lines depends on font size, margins, paper size, etc.

Have fun.

---- Andy

 

[macropod]

Unless every line ends with a carriage return, it will be hard to determine how many lines there are in the document. Word has a 'word wrap' and numbers of lines depends on font size, margins, paper size, etc.

Where 'etc' includes the current printer driver! Simply changing printer drivers can change what appears on a given line...

Cheers
Paul Edstein
[MS MVP - Word]

 

[kphu]

Thanks for the tips...question, is there a way to find out if your on the last line of the document?

Thanks,

Ken

 

[kphu]

I was able to get my code to work fine in word but now I was asked to create it as a vbs file that accepts 2 parameters.

For some reason why I'm not getting anything action when I run it through cmd.

Any idea why? If my question is in the wrong sub forum, please let me know and I'll ask in the vbscript forum.

Thanks in advance. Ken

Here's my code...

Sub test(pth,fname)

dim objArgs
Set objArgs = Wscript.Arguments         
count = objArgs.count   
pth = objArgs(0)   
fname = objArgs(1)
    Dim fso
    Dim outfile
    Dim lCurrentStart
    Dim lCurrentEnd 
    Dim lDocumentEnd
    Dim lOutputCount
    Dim fn
    Dim yn
    Dim oWord    

    Set fso = CreateObject("Scripting.FileSystemObject")
    lOutputCount = 0
    
    'Launch Word and make it visible
    Set oWord = CreateObject("Word.Application")
    oWord.Visible = False
    
    'check path
    if right(pth,1) = "\" then
    else
    pth = pth & "\"
    end if

    'check file is a word document.
    if right(fname,3) = "doc" then		
    fn = left(fname,len(fname)-4)
    yn = "y"
    else
    if right(fname,4) = "docx" then
    fn = left(fname,len(fname)-5)
    yn = "y"
    else
    yn = "n"
    end if
    end if
	
   if yn = "y" then
    'Open the test document
    Set oDoc = oWord.Documents.Open (pth & fname)
    
    'Set the margins in the document so it spaces the data into predefined sizes.
    With oDoc.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(2.75)
        .BottomMargin = InchesToPoints(2.88)
        .LeftMargin = InchesToPoints(0.25)
        .RightMargin = InchesToPoints(0.5)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(8.5)
        .PageHeight = InchesToPoints(11)
        .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
    
    'Find the beginning end of the document
    oDoc.Select
    lCurrentStart = oWord.Selection.Start
    lCurrentEnd = lCurrentStart
    lDocumentEnd = oWord.Selection.End
    
    'Move the insertion point to the beginning of the document
    oWord.Selection.Collapse wdCollapseStart
    
    Do While (lCurrentEnd < lDocumentEnd)
        'Move the insertion pointer to the bottom of this page
        oWord.Browser.Target = wdBrowsePage
        oWord.Browser.Next
        lCurrentEnd = oWord.Selection.End
        
        'On the last page, the start and end will be the same
        If (lCurrentStart = lCurrentEnd) Then
            lCurrentEnd = lDocumentEnd
        End If
        
        'Capture the Range of the current page
        Set oRange = oDoc.Range(lCurrentStart, lCurrentEnd)
        
        'Create a new document and copy the range to it
        Set oNewDoc = oWord.Documents.Add
        oRange.Copy
        oNewDoc.Range(0, 0).Paste
        
        'Release the Range so we don't leak references
        Set oRange = Nothing
        
        'Save the new document and close it
        oNewDoc.SaveAs (pth & fn & "_" & lOutputCount + 1 & ".docx")
             ' You can save as another FileFormat. If so, change the
             '  file extension accordingly.
        oNewDoc.Close
        Set oNewDoc = Nothing
        
        'Increment the output counter so we don't overwrite this file later
        lOutputCount = lOutputCount + 1
        
        'Reset the current start position
        lCurrentStart = oWord.Selection.End
    Loop
    
oDoc.Close False
oWord.Quit
msgbox "Finished"

Set outfile = fso.CreateTextFile(pth & fn & ".txt", True)
outfile.writeline "Success|" & lOutputCount + 1

outfile.Close True

Set fso = Nothing
Set outfile = Nothing
exit sub
Else
msgbox "Didn't run"
End if


End Sub

 

[SkipVought]

For some reason why I'm not getting anything action when I run it through cmd.

Please post the code where you call this procedure.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[kphu]

In command prompt i'm navigate to the directory in which the vbs file is saved in this case c:\. The vbs file name is splitworddocs.vbs.

c:\>splitworddocs.vbs "c:\users\kap\documents\consulting\cmayberry", "450401.doc
"

 

[SkipVought]

Sorry, this forum is VBA not VBS, forum329.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[kphu]

right...I'll move it.

Thanks,

Ken