Consulting

Results 1 to 11 of 11

Thread: Split document then save with specific file names

  1. #1
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location

    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
    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    You could, of course, save your document, then:
    • make two copies of it; and
    • open each copy in turn and delete the unwanted content...
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    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.

    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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

  5. #5
    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.

    SaveLetter ActiveDocument
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  6. #6
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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)?
    Last edited by HTSCF Fareha; 03-30-2021 at 02:18 AM.

  7. #7
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by HTSCF Fareha View Post
    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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  8. #8
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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.

    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.

    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

  9. #9
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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

  10. #10
    Change the macro in the ThisDocument folder to

    Option Explicit
    
    
    Private Sub Document_New()
        FillForm
    lbl_Exit:
        Set m_oFrm = Nothing
        Exit Sub
    End Sub
    In a normal module
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    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
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •