Excel to Word Doc VBA modification

MWhiteDesigns

Well-known Member
Joined
Nov 17, 2010
Messages
646
Office Version
  1. 2016
Platform
  1. Windows
Good morning,
I have a routine that a co worker made that needs to be tweaked (shown below).

I have a excel sheet that has 4 columns. The values for each row currently get placed into the word documents text fields. Once the row is completed, it saves the file and opens up a new word document to do the same with the next row.

I need to change this to continually place the values of each row until into the word doc text fields until there are no more text fields. e.g. column value 1,2,3,4 of row 1 gets placed in the first 4 text fields, then excel goes to the next row (instead of saving the document) and places the values for the next for of column 1,2,3,4 into the next 4 text fields and so on.

Thanks in advance!

Code:
Sub Populate_Template()
sPath = "\\*********\ID\ID_3002_Letters\"
        
Dim wd As Object
Set wd = CreateObject("Word.Application")


FileToOpen = ActiveSheet.Name & ".docx"


wd.Visible = True


wd.Documents.Open sPath & FileToOpen


'Loop through form elements here
iRow = 3
Do Until ActiveSheet.Cells(iRow, 1) = ""
iCol = 1
    Do Until Cells(1, iCol) = ""
        dObj = ActiveSheet.Cells(1, iCol)
        dVal = ActiveSheet.Cells(iRow, iCol)
        wd.activedocument.FormFields(dObj).Result = dVal
        iCol = iCol + 1
    Loop
    LtrSaveName = sPath & Cells(iRow, 1) & " - " & FileToOpen
    wd.activedocument.SaveAs2 (LtrSaveName)
    iRow = iRow + 1
Loop


wd.Quit


Set wd = Nothing


MsgBox "All done populating the template. Please review output at: " & sPath


End Sub
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Good evening

The code below refers to the Word fields by index:

Code:
Sub Populate_Template()
Dim wd As Object, rw%, pth, FileToOpen$, col%, wf%, doc As Document
pth = Split(Environ(29), "=")(1) & "\"
Set wd = CreateObject("Word.Application")
FileToOpen = ActiveSheet.Name & ".docm"
wd.Visible = True
wd.Documents.Open pth & FileToOpen
Set doc = wd.ActiveDocument
rw = 3: wf = 1
Do Until ActiveSheet.Cells(rw, 1) = "" Or wf > doc.FormFields.Count
    col = 1
    Do Until Cells(rw, col) = ""
        doc.FormFields(wf).Result = ActiveSheet.Cells(rw, col)
        col = col + 1
        wf = wf + 1
    Loop
    rw = rw + 1
Loop
doc.SaveAs2 pth & Cells(rw - 1, col - 1) & "-" & FileToOpen
'wd.Quit
Set wd = Nothing
MsgBox "All done populating the template. Please review output at: " & pth
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top