CODEWITHSUNDEEP
vbasplitms-wordoutline
Rubén P S
Rubén P S

Reputation: 113

VBA WORD How to split doc in X docs?

I'd like to split a doc file with some Units in individual units, taking Level 1 Outlined as stop mark. Someone could help me with this? As you can see, I'm a total newbie here. Thanks a lot

Upvotes: 1

Views: 307

Answers (2)

Rubén P S
Rubén P S

Reputation: 113

Well, I did this. It's not exactly and auto-split process but it does the thing:

Sub CutSelect()
    Dim ruta As String
    Selection.Cut

    ruta = ActiveDocument.Path
    Dim doc As Document
            x = x + 1
            Set doc = Documents.Add
            Selection.Paste
            '-----You can add some other things to do here
            doc.SaveAs ruta & "\" & "Tema " & Format(x, "0")
            '-----So here
            doc.Close True

End Sub

X is set as global var. You can also do some Sub to restart counting as you wish

Upvotes: 1

Rubén P S
Rubén P S

Reputation: 113

Found this. It'll work for text-only documents.

Option Explicit

Sub SplitNotes(delim As String, strFilename As String)
    Dim doc As Document
    Dim arrNotes
    Dim I As Long
    Dim x As Long
    Dim Response As Integer
    Dim ruta As String
    ruta = ActiveDocument.Path

    'Vector con los delimitadores
    arrNotes = Split(ActiveDocument.Range, delim)

    Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections. Do you wish to proceed?", 4)
    If Response = 7 Then Exit Sub
    For I = LBound(arrNotes) To UBound(arrNotes)
        If Trim(arrNotes(I)) <> "" Then
            x = x + 1
            Set doc = Documents.Add
            doc.Range = arrNotes(I)
            doc.SaveAs ruta & "\" & strFilename & Format(x, "0")
            doc.Close True
        End If
    Next I
End Sub


Sub test()
     '      delimiter & filename
    SplitNotes "///", "Tema "
End Sub

But I'd need to do this with full content, tables, images, etc.

I'm working on this too:

Sub TESTSplitNotes(delim As String, strFilename As String)
    Dim doc As Document
    Dim arrNotes
    Dim I As Long

    Dim Response As Integer
    Dim ruta As String
    Dim p As Paragraph
    ruta = ActiveDocument.Path
    Dim c As Range
    Set c = ActiveDocument.Content
     With c.Find
        .Text = delim & "(*)" & delim
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Replacement.Text = ""
    End With
    '.Select
    c.Find.Execute
While c.Find.Found
Debug.Print c.Start
Debug.Print c.End
'COPY CONTENT
        Set r = ActiveDocument.Range(Start:=ini, End:=c.End - 3)
        r.Select
        Debug.Print ActiveDocument.Range.End
        Selection.Copy
        x = x + 1
        Set doc = Documents.Add
        Selection.Paste
'PASTE CONTENT
        doc.SaveAs ruta & "\" & strFilename & Format(x, "0")
        doc.Close True
        ini = c.End - 3
Wend
End Sub

This work the first time, But I don't know how the Search iterates between found elements. After it works the first time,, c.end doesn't increase, it still be at the first position (for example, 3106). Does someone know why??

Upvotes: 0

Related Questions