Consulting

Results 1 to 15 of 15

Thread: Populate multiple templates using 1 userform

  1. #1

    Populate multiple templates using 1 userform

    Hello. I have multiple forms that require the same set of data. What I am trying to do is see if I can create one userform, enter the data in there and have it populate the required fields across multiple templates/files.

    I am able to do this in a single document by using bookmarks and have what is entered in the userform to populate those bookmarks. But wanted a way where this can be done across multiple documents at once.

    Here is what I have so far:

    Private Sub CommandButton1_Click()

    Dim fname As Range
    Set fname = ActiveDocument.Bookmarks("fname").Range
    fname.Text = Me.TextBox1.Value

    Dim lname As Range
    Set lname = ActiveDocument.Bookmarks("lname").Range
    lname.Text = Me.TextBox2.Value

    Dim address As Range
    Set address = ActiveDocument.Bookmarks("address").Range
    address.Text = Me.TextBox3.Value

    Dim dob As Range
    Set dob = ActiveDocument.Bookmarks("dob").Range
    dob.Text = Me.TextBox4.Value

    Dim amount As Range
    Set amount = ActiveDocument.Bookmarks("amount").Range
    amount.Text = Me.TextBox5.Value

    Dim period As Range
    Set period = ActiveDocument.Bookmarks("period").Range
    period.Text = Me.TextBox6.Value

    Me.Repaint
    UserForm1.Hide

    End Sub


    Private Sub Label4_Click()

    End Sub

    Private Sub TextBox4_Change()

    End Sub

    Private Sub UserForm_Click()

    End Sub


    Any help is appreciated. thank you!
    Last edited by lordbodom; 08-18-2020 at 11:37 PM.

  2. #2
    You have to open, or create, the documents to process and process them separately e.g.

    Private Sub CommandButton1_Click()
    
    Dim oRng As Range
    Dim oDoc1 As Document
    Dim oDoc2 As Document
    Dim oDoc3 As Document
    
        'create (or open) the documents
        Set oDoc1 = Documents.Add("C:\Path\Template1.dotx")
        Set oDoc2 = Documents.Add("C:\Path\Template2.dotx")
        Set oDoc3 = Documents.Add("C:\Path\Template3.dotx")
    
        'process each document
        'fname
        If oDoc1.Bookmarks.Exists("fname") = True Then
            Set oRng = oDoc1.Bookmarks("fname").Range
            oRng.Text = TextBox1.value
            oDoc1.Bookmarks.Add "fname", oRng
        End If
        If oDoc2.Bookmarks.Exists("fname") = True Then
            Set oRng = oDoc2.Bookmarks("fname").Range
            oRng.Text = TextBox1.value
            oDoc2.Bookmarks.Add "fname", oRng
        End If
        If oDoc3.Bookmarks.Exists("fname") = True Then
            Set oRng = oDoc3.Bookmarks("fname").Range
            oRng.Text = TextBox1.value
            oDoc3.Bookmarks.Add "fname", oRng
        End If
    
        'lname
        If oDoc1.Bookmarks.Exists("lname") = True Then
            Set oRng = oDoc1.Bookmarks("lname").Range
            oRng.Text = TextBox2.value
            oDoc1.Bookmarks.Add "lname", oRng
        End If
        If oDoc2.Bookmarks.Exists("lname") = True Then
            Set oRng = oDoc2.Bookmarks("lname").Range
            oRng.Text = TextBox2.value
            oDoc2.Bookmarks.Add "lname", oRng
        End If
        If oDoc3.Bookmarks.Exists("lname") = True Then
            Set oRng = oDoc3.Bookmarks("lname").Range
            oRng.Text = TextBox2.value
            oDoc3.Bookmarks.Add "lname", oRng
        End If
    
        'address
        If oDoc1.Bookmarks.Exists("address") = True Then
            Set oRng = oDoc1.Bookmarks("address").Range
            oRng.Text = TextBox3.value
            oDoc1.Bookmarks.Add "address", oRng
        End If
        If oDoc2.Bookmarks.Exists("address") = True Then
            Set oRng = oDoc2.Bookmarks("address").Range
            oRng.Text = TextBox3.value
            oDoc2.Bookmarks.Add "address", oRng
        End If
        If oDoc3.Bookmarks.Exists("address") = True Then
            Set oRng = oDoc3.Bookmarks("address").Range
            oRng.Text = TextBox3.value
            oDoc3.Bookmarks.Add "address", oRng
        End If
    
        'dob
        If oDoc1.Bookmarks.Exists("dob") = True Then
            Set oRng = oDoc1.Bookmarks("dob").Range
            oRng.Text = TextBox4.value
            oDoc1.Bookmarks.Add "dob", oRng
        End If
        If oDoc2.Bookmarks.Exists("dob") = True Then
            Set oRng = oDoc2.Bookmarks("dob").Range
            oRng.Text = TextBox4.value
            oDoc2.Bookmarks.Add "dob", oRng
        End If
        If oDoc3.Bookmarks.Exists("dob") = True Then
            Set oRng = oDoc3.Bookmarks("dob").Range
            oRng.Text = TextBox4.value
            oDoc3.Bookmarks.Add "dob", oRng
        End If
    
        'amount
        If oDoc1.Bookmarks.Exists("amount") = True Then
            Set oRng = oDoc1.Bookmarks("amount").Range
            oRng.Text = TextBox5.value
            oDoc1.Bookmarks.Add "amount", oRng
        End If
        If oDoc2.Bookmarks.Exists("amount") = True Then
            Set oRng = oDoc2.Bookmarks("amount").Range
            oRng.Text = TextBox5.value
            oDoc2.Bookmarks.Add "amount", oRng
        End If
        If oDoc3.Bookmarks.Exists("amount") = True Then
            Set oRng = oDoc3.Bookmarks("amount").Range
            oRng.Text = TextBox5.value
            oDoc3.Bookmarks.Add "amount", oRng
        End If
    
        'period
        If oDoc1.Bookmarks.Exists("period") = True Then
            Set oRng = oDoc1.Bookmarks("period").Range
            oRng.Text = TextBox6.value
            oDoc1.Bookmarks.Add "period", oRng
        End If
        If oDoc2.Bookmarks.Exists("period") = True Then
            Set oRng = oDoc2.Bookmarks("period").Range
            oRng.Text = TextBox6.value
            oDoc2.Bookmarks.Add "period", oRng
        End If
        If oDoc3.Bookmarks.Exists("period") = True Then
            Set oRng = oDoc3.Bookmarks("period").Range
            oRng.Text = TextBox6.value
            oDoc3.Bookmarks.Add "period", oRng
        End If
    
        Unload Me
    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

  3. #3
    Quote Originally Posted by gmayor View Post
    You have to open, or create, the documents to process and process them separately e.g.

    Private Sub CommandButton1_Click()
    
    Dim oRng As Range
    Dim oDoc1 As Document
    Dim oDoc2 As Document
    Dim oDoc3 As Document
    
        'create (or open) the documents
        Set oDoc1 = Documents.Add("C:\Path\Template1.dotx")
        Set oDoc2 = Documents.Add("C:\Path\Template2.dotx")
        Set oDoc3 = Documents.Add("C:\Path\Template3.dotx")
    
        'process each document
        'fname
        If oDoc1.Bookmarks.Exists("fname") = True Then
            Set oRng = oDoc1.Bookmarks("fname").Range
            oRng.Text = TextBox1.value
            oDoc1.Bookmarks.Add "fname", oRng
        End If
        If oDoc2.Bookmarks.Exists("fname") = True Then
            Set oRng = oDoc2.Bookmarks("fname").Range
            oRng.Text = TextBox1.value
            oDoc2.Bookmarks.Add "fname", oRng
        End If
        If oDoc3.Bookmarks.Exists("fname") = True Then
            Set oRng = oDoc3.Bookmarks("fname").Range
            oRng.Text = TextBox1.value
            oDoc3.Bookmarks.Add "fname", oRng
        End If
    
        'lname
        If oDoc1.Bookmarks.Exists("lname") = True Then
            Set oRng = oDoc1.Bookmarks("lname").Range
            oRng.Text = TextBox2.value
            oDoc1.Bookmarks.Add "lname", oRng
        End If
        If oDoc2.Bookmarks.Exists("lname") = True Then
            Set oRng = oDoc2.Bookmarks("lname").Range
            oRng.Text = TextBox2.value
            oDoc2.Bookmarks.Add "lname", oRng
        End If
        If oDoc3.Bookmarks.Exists("lname") = True Then
            Set oRng = oDoc3.Bookmarks("lname").Range
            oRng.Text = TextBox2.value
            oDoc3.Bookmarks.Add "lname", oRng
        End If
    
        'address
        If oDoc1.Bookmarks.Exists("address") = True Then
            Set oRng = oDoc1.Bookmarks("address").Range
            oRng.Text = TextBox3.value
            oDoc1.Bookmarks.Add "address", oRng
        End If
        If oDoc2.Bookmarks.Exists("address") = True Then
            Set oRng = oDoc2.Bookmarks("address").Range
            oRng.Text = TextBox3.value
            oDoc2.Bookmarks.Add "address", oRng
        End If
        If oDoc3.Bookmarks.Exists("address") = True Then
            Set oRng = oDoc3.Bookmarks("address").Range
            oRng.Text = TextBox3.value
            oDoc3.Bookmarks.Add "address", oRng
        End If
    
        'dob
        If oDoc1.Bookmarks.Exists("dob") = True Then
            Set oRng = oDoc1.Bookmarks("dob").Range
            oRng.Text = TextBox4.value
            oDoc1.Bookmarks.Add "dob", oRng
        End If
        If oDoc2.Bookmarks.Exists("dob") = True Then
            Set oRng = oDoc2.Bookmarks("dob").Range
            oRng.Text = TextBox4.value
            oDoc2.Bookmarks.Add "dob", oRng
        End If
        If oDoc3.Bookmarks.Exists("dob") = True Then
            Set oRng = oDoc3.Bookmarks("dob").Range
            oRng.Text = TextBox4.value
            oDoc3.Bookmarks.Add "dob", oRng
        End If
    
        'amount
        If oDoc1.Bookmarks.Exists("amount") = True Then
            Set oRng = oDoc1.Bookmarks("amount").Range
            oRng.Text = TextBox5.value
            oDoc1.Bookmarks.Add "amount", oRng
        End If
        If oDoc2.Bookmarks.Exists("amount") = True Then
            Set oRng = oDoc2.Bookmarks("amount").Range
            oRng.Text = TextBox5.value
            oDoc2.Bookmarks.Add "amount", oRng
        End If
        If oDoc3.Bookmarks.Exists("amount") = True Then
            Set oRng = oDoc3.Bookmarks("amount").Range
            oRng.Text = TextBox5.value
            oDoc3.Bookmarks.Add "amount", oRng
        End If
    
        'period
        If oDoc1.Bookmarks.Exists("period") = True Then
            Set oRng = oDoc1.Bookmarks("period").Range
            oRng.Text = TextBox6.value
            oDoc1.Bookmarks.Add "period", oRng
        End If
        If oDoc2.Bookmarks.Exists("period") = True Then
            Set oRng = oDoc2.Bookmarks("period").Range
            oRng.Text = TextBox6.value
            oDoc2.Bookmarks.Add "period", oRng
        End If
        If oDoc3.Bookmarks.Exists("period") = True Then
            Set oRng = oDoc3.Bookmarks("period").Range
            oRng.Text = TextBox6.value
            oDoc3.Bookmarks.Add "period", oRng
        End If
    
        Unload Me
    End Sub
    Thank you! Is there an easy way to autosave the documents without having to go to each of them and save manually? Much appreciated!
    Last edited by lordbodom; 08-19-2020 at 04:01 AM.

  4. #4
    Save them in code after updating and before you close the userform
    oDoc1.Save
    oDoc2.Save
    oDoc3.Save
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Quote Originally Posted by gmayor View Post
    Save them in code after updating and before you close the userform
    oDoc1.Save
    oDoc2.Save
    oDoc3.Save
    Thank you. I played around a bit and set it up so that the text entered in the first name and last name field will create a sub folder to save the files.

    newfol = TextBox1.Text & " " & TextBox2.Text
    ChDir "C:\Users\amask\Desktop\userform"
    On Error Resume Next
    MkDir (newfol)

    oDoc1.SaveAs "C:\Users\amask\Desktop\userform\Filename.docx"
    oDoc2.SaveAs "C:\Users\amask\Desktop\userform\AnotherFilename.docx"
    oDoc3.SaveAs "C:\Users\amask\Desktop\userform\Another1Filename.docx"

    Just one more help if you can. What path should be given to save the document? Since the folder name is dynamic and can change, having something specific wont work?

  6. #6

  7. #7
    VBAX Contributor
    Joined
    Jul 2020
    Location
    Sun Prairie
    Posts
    118
    Location
    Note, you use the word templates when talking about forms.
    In Word jargon, the two are far from synonymous.
    A template is a file in the format .dotx, .dotm, or .dot. Other documents are created based upon it.
    I would guess that you are trying to fill new documents, perhaps based upon templates, not templates.

  8. #8
    Quote Originally Posted by Chas Kenyon View Post
    Note, you use the word templates when talking about forms.
    In Word jargon, the two are far from synonymous.
    A template is a file in the format .dotx, .dotm, or .dot. Other documents are created based upon it.
    I would guess that you are trying to fill new documents, perhaps based upon templates, not templates.
    Sorry, yes I am trying to fill in new documents. Heres basically what I have:


    • Folder in my desktop where I have the document where I have the userform
    • 3 "templates" in that folder which has bookmarks
    • Once the userform is filled, it creates 3 new files based on the 3 "templates"


    I have creating the 3 new files ready thanks to the above code. What im trying to do now is created a sub folder and name it from the text entered in the userfield. I am able to do this as well. What im looking for now is to see how to get the files saved in this new sub folder instead of the folder where the "templates" are.

    I have attached my userform doc with my code.

    Sorry about the cross post, I figured this forum was better suited for vba help.
    Attached Files Attached Files

  9. #9
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    @lordbodam --

    Please take a minute to read the FAQ in my signature, especially the part about cross-posting
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  10. #10
    Sorry for the trouble. I seem to have got it working using:

    oDoc1.SaveAs "C:\Users\amask\Desktop\userform" & newfol & "" & "Document1.docx"
    oDoc2.SaveAs "C:\Users\amask\Desktop\userform" & newfol & "" & "Document2.docx"
    oDoc3.SaveAs "C:\Users\amask\Desktop\userform" & newfol & "" & "Document3.docx"

    Thank you all.

  11. #11
    VBAX Contributor
    Joined
    Jul 2020
    Location
    Sun Prairie
    Posts
    118
    Location
    I assume the variable newfol contains the backslashes at beginning and end to designate the path.

  12. #12
    Quote Originally Posted by Chas Kenyon View Post
    I assume the variable newfol contains the backslashes at beginning and end to designate the path.
    It creates the subfolder in this directory: C:\Users\amask\Desktop\userform

    Seems to be working from the tests Iv done.

  13. #13
    You would be better using
    Environ("USERPROFILE") & Chr(92) & "Desktop\userform\"
    if the template is to be employed by different users; and ensure it is present by using the following to call the CreateFolders function before trying to save to that folder
    CreateFolders Environ("USERPROFILE") & Chr(92) & "Desktop\userform\"
    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

  14. #14
    Quote Originally Posted by gmayor View Post
    You would be better using
    Environ("USERPROFILE") & Chr(92) & "Desktop\userform\"
    if the template is to be employed by different users; and ensure it is present by using the following to call the CreateFolders function before trying to save to that folder
    CreateFolders Environ("USERPROFILE") & Chr(92) & "Desktop\userform\"
    Private Function CreateFolders(strPath As String)
    'Graham Mayor -  - 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
    Thanks for this. Unfortunately my vba skillset is too limited to understand this. I seem to have it do what I need with the simple code i put in. Thank you for all the help!

  15. #15
    It is not difficult. Put the CreateFolders Function in the same module as your code. This creates any missing folders in the user's paths
    Then replace the code segment
    newfol = TextBox1.Text & " " & TextBox2.Text
    ChDir "C:\Users\amask\Desktop\userform"
    On Error Resume Next
    MkDir (newfol)
    with
    newfol = TextBox1.Text &  " " & TextBox2.Text
    Createfolders Environ("USERPROFILE") & "\Desktop\userform\" & newfol
    and replace
    oDoc1.SaveAs "C:\Users\amask\Desktop\userform" & newfol & "" & "Document1.docx"
    oDoc2.SaveAs "C:\Users\amask\Desktop\userform" & newfol & "" & "Document2.docx"
    oDoc3.SaveAs "C:\Users\amask\Desktop\userform" & newfol & "" & "Document3.docx"
    with
    oDoc1.SaveAs Environ("USERPROFILE") & "\Desktop\userform\" & newfol & "\Document1.docx"
    oDoc2.SaveAs Environ("USERPROFILE") & "\Desktop\userform\" & newfol & "\Document2.docx"
    oDoc3.SaveAs Environ("USERPROFILE") & "\Desktop\userform\" & newfol & "\Document3.docx"
    Then the code can be run by anyone and it will create the required folders as needed.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

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