Generating Multiple MS Word Docs from Different Excel Rows

Question

Hello,

I recently created a code, in excel, that inputs data from row 3, columns A:J, into a MS word document. I did this by creating bookmarks in Word and referencing those bookmarks in my excel code. Moving forward, what I would like to do is add additional rows and create multiple Word documents based on the individual row's columns. For example, if I had 5 rows I would generate 5 different Word documents. Is this even possible? Below is my code for a single row.

Sub Word_Test()

 On Error GoTo errorHandler

 Dim WDApp As Word.Application

 Dim myDoc As Word.Document

 Dim mywdRange As Word.Range

 Dim CatD As Excel.Range

 Dim CatB As Excel.Range

 Set WDApp = New Word.Application

 With WDApp

 .Visible = True

 .WindowState = wdWindowStateMaximize

 End With

 Set myDoc = WDApp.Documents.Add(Template:="C:\Desktop\Test_Test.docm")

 Set EOD = Sheets("Sheet1").Range("A3")

 Set IED = Sheets("Sheet1").Range("B3")

 Set FED = Sheets("Sheet1").Range("C3")

 Set IP = Sheets("Sheet1").Range("D3")

 Set MN = Sheets("Sheet1").Range("E3")

 Set MName = Sheets("Sheet1").Range("F3")

 Set LOCA = Sheets("Sheet1").Range("G3")

 Set NOB = Sheets("Sheet1").Range("H3")

 Set BOC = Sheets("Sheet1").Range("I3")

 Set Add = Sheets("Sheet1").Range("J3")

With myDoc.Bookmarks

 .Item("EOD").Range.InsertAfter EOD

 .Item("IED").Range.InsertAfter IED

 .Item("FED").Range.InsertAfter FED

 .Item("IP").Range.InsertAfter IP

 .Item("MN").Range.InsertAfter MN

 .Item("MName").Range.InsertAfter MName

 .Item("LOCA").Range.InsertAfter LOCA

 .Item("NOB").Range.InsertAfter NOB

 .Item("BOC").Range.InsertAfter BOC

 .Item("Add").Range.InsertAfter Add

 End With

errorHandler:

 Set WDApp = Nothing

 Set myDoc = Nothing

 Set mywdRange = Nothing

 End Sub

Answer 1

Replace the comments

        ' Optionally add lines here to save and close the document

        ' Otherwise you'll end up with a whole bunch of open documents

with

        myDoc.SaveAs2 Filename:=Sheets("Sheet1").Range("H" & r) & ".docx", _

            FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False

        myDoc.Close

Answer 2

Like this:

Sub Word_Test()

    Dim WDApp As Word.Application

    Dim myDoc As Word.Document

    Dim mywdRange As Word.Range

    Dim r As Long

    Dim m As Long

    On Error GoTo errorHandler

    Set WDApp = New Word.Application

    With WDApp

        .Visible = True

        .WindowState = wdWindowStateMaximize

    End With

    With Sheets("Sheet1")

        m = .Range("A" & .Rows.Count).End(xlUp).Row

    End With

    For r = 3 To m

        Set myDoc = WDApp.Documents.Add(Template:="C:\Desktop\Test_Test.docm")

        With myDoc.Bookmarks

            .Item("EOD").Range.InsertAfter Sheets("Sheet1").Range("A" & r)

            .Item("IED").Range.InsertAfter Sheets("Sheet1").Range("B" & r)

            .Item("FED").Range.InsertAfter Sheets("Sheet1").Range("C" & r)

            .Item("IP").Range.InsertAfter Sheets("Sheet1").Range("D" & r)

            .Item("MN").Range.InsertAfter Sheets("Sheet1").Range("E" & r)

            .Item("MName").Range.InsertAfter Sheets("Sheet1").Range("F" & r)

            .Item("LOCA").Range.InsertAfter Sheets("Sheet1").Range("G" & r)

            .Item("NOB").Range.InsertAfter Sheets("Sheet1").Range("H" & r)

            .Item("BOC").Range.InsertAfter Sheets("Sheet1").Range("I" & r)

            .Item("Add").Range.InsertAfter Sheets("Sheet1").Range("J" & r)

        End With

        ' Optionally add lines here to save and close the document

        ' Otherwise you'll end up with a whole bunch of open documents

    Next r

errorHandler:

    Set WDApp = Nothing

    Set myDoc = Nothing

    Set mywdRange = Nothing

End Sub

Answer 3

Thank you very much, my problem now though is placing the files in a specific folder I created. Right now, they are being saved to my documents folder. Should I add a line underneath with the code "custompath" and then include the file name?

        myDoc.SaveAs2 Filename:=Sheets("Sheet1").Range("H" & r) & ".docx", _

            FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False

        myDoc.Close

Answer 4

Thank you so much this works perfectly, moving forward I will want to save and close the newly created word docs. Ideally, I would like to save the file using the text in the Excel column H. Can I just reference the cell and still use a code like this:

.SaveAs2 Filename:=("file name goes here"),

FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False