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!

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

Code:

---

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

---

Quote:

---

Originally Posted by gmayor

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

Code:

---

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!

Save them in code after updating and before you close the userform

Code:

---

oDoc1.Save
oDoc2.Save
oDoc3.Save

---

Quote:

---

Originally Posted by gmayor

Save them in code after updating and before you close the userform

Code:

---

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?

This appears to be a cross-post to https://www.msofficeforums.com/word/45482-fill-multiple-word-docs-1-vb-userform.html.

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.

Quote:

---

Originally Posted by Chas Kenyon

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.

@lordbodam --

Quote:

---

This appears to be a cross-post to https://www.msofficeforums.com/word/45482-fill-multiple-word-docs-1-vb-userform.html.

---

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

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.

I assume the variable newfol contains the backslashes at beginning and end to designate the path.

Quote:

---

Originally Posted by Chas Kenyon

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.

You would be better using

Code:

---

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

Code:

---

CreateFolders Environ("USERPROFILE") & Chr(92) & "Desktop\userform\"

---

Code:

---

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

---

Quote:

---

Originally Posted by gmayor

You would be better using

Code:

---

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

Code:

---

CreateFolders Environ("USERPROFILE") & Chr(92) & "Desktop\userform\"

---

Code:

---

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!

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

Code:

---

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

---

with

Code:

---

newfol = TextBox1.Text &  " " & TextBox2.Text
Createfolders Environ("USERPROFILE") & "\Desktop\userform\" & newfol

---

and replace

Code:

---

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

Code:

---

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.