Split document then save with specific file names

I have been scouring the internet to find a sub macro solution or something that comes close, but so far have found nothing that fits my requirements.

Those that I have found have focussed on mailmerge or will not divide the document into the required separated documents and/or have produced documents that have broken the existing page format and design.

I have a three page document that has been populated via VBA UserForm (as attached). This needs to be separated into two separate documents with fixed file names. The first document should consist of the first two pages and the second from the final third page. Document one shall be named "breakdown report.docx" and the second "repair plan.docx", which will be saved in a specific folder located at "C:\Users\Repair\Documents\Breakdowns".

Many thanks!
Steve

You could, of course, save your document, then:
• make two copies of it; and
• open each copy in turn and delete the unwanted content...

Based on your example, the following should work, however Windows security will almost certainly not allow you to save to that path (unless the User name is 'Repair'). Use the path in the example instead. You can call the macro from your process, however it might be simpler just to create two documents from the outset.

Code:

---

Sub SaveLetter(oDoc As Document)
Dim oTempDoc As Document
Dim oRng As Range
Dim sPath As String
Const strName1 As String = "breakdown report.docx"
Const strName2 As String = "repair plan.docx"
    sPath = Environ("USERPROFILE") & "\Repair\Documents\Breakdowns\"
    CreateFolders sPath
    oDoc.Save
    Set oRng = oDoc.Range(0, 0)
    Selection.GoTo What:=wdGoToPage, which:=wdGoToNext, Name:="2"
    oRng.End = ActiveDocument.Bookmarks("\page").Range.End
    Set oTempDoc = Documents.Add(Template:=oDoc.FullName)
    oTempDoc.Range.FormattedText = oRng.FormattedText
    oTempDoc.Range.Find.Execute findText:="^m", Replacewith:="", Replace:=wdReplaceAll
    oTempDoc.SaveAs2 sPath & strName1
    oRng.Collapse 0
    oRng.End = oDoc.Range.End
    Set oTempDoc = Documents.Add(Template:=oDoc.FullName)
    oTempDoc.Range.FormattedText = oRng.FormattedText
    oTempDoc.SaveAs2 sPath & strName2
    oDoc.Close 0
lbl_Exit:
    Set oTempDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub


Private Function CreateFolders(strPath As String)
'Graham Mayor - http://www.gmayor.com - Last updated - 31 May 2017
'Creates the full path 'strPath' if missing or incomplete
Dim strTempPath As String
Dim lng_Path As Long
Dim VPath As Variant
Dim oFSO As Object
Dim i As Integer
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    VPath = Split(strPath, "\")
    If Left(strPath, 2) = "\\" Then
        strPath = "\\" & VPath(2) & "\"
        For lng_Path = 3 To UBound(VPath)
            strPath = strPath & VPath(lng_Path) & "\"
            If Not oFSO.FolderExists(strPath) Then MkDir strPath
        Next lng_Path
    Else
        strPath = VPath(0) & "\"
        For lng_Path = 1 To UBound(VPath)
            strPath = strPath & VPath(lng_Path) & "\"
            If Not oFSO.FolderExists(strPath) Then MkDir strPath
        Next lng_Path
    End If
lbl_Exit:
    Set oFSO = Nothing
    Exit Function
End Function

---

Many thanks Graham for taking a look at this.

In my original description I should've added that the two documents are currently created separately. The need to have them created at once is to improve efficiency as a number of entries are repeated across both.

You are correct in the User name and this was an oversight on my part. I left your code as is and was allowing it to run. Unfortunately I am getting a "argument not optional" on the line calling the sub 'SaveLetter'.

I'm certain that I'm probably calling the sub wrong or something else that should be obvious, but I am not seeing it I'm afraid. I would really appreciate a nudge in the right direction!

Thanks again.
Steve

The argument that is not optional is the document 'oDoc'. If this is the active document then you call it adding the document to save e.g.

Code:

---

SaveLetter ActiveDocument

---

Thanks, Graham.

Okay, I've ammended as per your previous post. Unfortunately I initially get a prompt box to save the document(s). If I cancel this and ignore this prompt (gives a runtime error '4198' command failed), the two documents are saved correctly in the correct folder. Almost there!

Thanks!
Steve

Could I please send the document to you via personal email (content is sensitive so not able to post here)?

Quote:

---

Originally Posted by HTSCF Fareha

In my original description I should've added that the two documents are currently created separately. The need to have them created at once is to improve efficiency as a number of entries are repeated across both.

---

But that is no reason to combine the documents, only to have to separate them again later...
Both could be opened together - as separate documents - and updated together without all this quite unnecessary circumlocution.

I tweaked your code a bit Graham, so that it removed the prompt to save the initital document. This initial document is also not required at the end, so have added a couple of lines to close then delete this.

Code:

---

Sub SaveLetter(oDoc As Document)
Dim oTempDoc As Document
Dim oRng As Range
Dim sPath As String
Const strName1 As String = "breakdown report.docx"
Const strName2 As String = "repair plan.docx"
Const strName3 As String = "Temp.docx"
    sPath = Environ("USERPROFILE") & "\Repair\Documents\Breakdowns\"
    CreateFolders sPath
    oDoc.SaveAs2 sPath & strName3                ' Create temporary document
    'oDoc.Save
    Set oRng = oDoc.Range(0, 0)
    Selection.GoTo What:=wdGoToPage, which:=wdGoToNext, Name:="2"
    oRng.End = ActiveDocument.Bookmarks("\page").Range.End
    Set oTempDoc = Documents.Add(Template:=oDoc.FullName)
    oTempDoc.Range.FormattedText = oRng.FormattedText
    oTempDoc.Range.Find.Execute findText:="^m", Replacewith:="", Replace:=wdReplaceAll
    oTempDoc.SaveAs2 sPath & strName1
    oRng.Collapse 0
    oRng.End = oDoc.Range.End
    Set oTempDoc = Documents.Add(Template:=oDoc.FullName)
    oTempDoc.Range.FormattedText = oRng.FormattedText
    oTempDoc.SaveAs2 sPath & strName2
    'oDoc.Close 0
    Documents(strName3).Close                    ' Close temporary document
    Kill sPath & strName3                        ' Delete temporary document
lbl_Exit:
    Set oTempDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

---

This has on the whole got me to where I want it. The only annoying thing now is that the UserForm insists on showing itself twice more at the end! Here is the code at the start and end of the Fill Form code.

Code:

---

Option Explicit

Private m_oFrm As frmNFAMalCom

Private Sub Document_New()
    Set m_oFrm = New frmNFAMalCom
    m_oFrm.Show
    If m_oFrm.Tag = "Enter" Then FillForm
lbl_Exit:
    'Unload m_oFrm
    Set m_oFrm = Nothing
    Exit Sub
End Sub

Sub FillForm()
    Dim oCtrl  As Control
    Dim oCC    As ContentControl
    Dim lngIndex As Long
    Dim strTC  As String
   
    CreatedDate
   
    With m_oFrm
.
.
.
.
.
lbl_Exit:
   
    SaveLetter ActiveDocument

    Exit Sub
   
End Sub

---

Any help very much appreciated.

Thanks!
Steve

This is so near, but I just cannot stop the UserForm from wanting to show itself after being run once. I have to press the 'Cancel' button on my UserForm twice (when this appears) then I get the required result of being left with only the two created documents open.

Thanks!
Steve

Change the macro in the ThisDocument folder to

Code:

---

Option Explicit


Private Sub Document_New()
    FillForm
lbl_Exit:
    Set m_oFrm = Nothing
    Exit Sub
End Sub

---

In a normal module

Code:

---

Option Explicit


Private m_oFrm As frmNFAMalCom


Sub FillForm()


Dim oCtrl As Control
Dim oCC As ContentControl
Dim lngIndex As Long
Dim strTC As String
    CreatedDate
    Set m_oFrm = New frmNFAMalCom
    With m_oFrm
        .Show
        .
        .
        .
        .
    End With
lbl_Exit:
    SaveLetter ActiveDocument
    Exit Sub
End Sub

---

Thanks for hanging in there with me Graham!

Alas, I have implemented the code / module as suggested but still end up with the UserForm showing twice at the end, requiring pressing the 'Cancel' button for each time it pops up.

I appreciate that this is not the done thing, but I would please like to provide a password protected compressed zip file containing my form, then send the password via PM if I may?

Apologies if this breaches any Forum rules.

Steve