Populate multiple templates using 1 userform

[lordbodom]

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!

[gmayor]

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

[lordbodom]

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!

[gmayor]

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

oDoc1.Save
oDoc2.Save
oDoc3.Save

[lordbodom]

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?

[Chas Kenyon]

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

[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.

[lordbodom]

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.

[Paul_Hossler]

@lordbodam --


This appears to be a cross-post to https://www.msofficeforums.com/word/45482-fill-multiple-word-docs-1-vb-userform.html. (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

[lordbodom]

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.

[Chas Kenyon]

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

[lordbodom]

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.

[gmayor]

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

[lordbodom]

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!

[gmayor]

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\" & newfoland 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.