Create Documents from a Templete Using a Excel Database Selecting Row-CodePudding

The intention of this code is to take the information of a excel database and then create a word document from a template and replace the required info. Also I put some Inputbox where you can choose the file saving location and the row you want the document to be created.

That's where the problem is. It effectivly take the information from the row I selected but when it's time to save, for some reason it saves 33 documents, which is the number of filled rows I have.

Can anyone help me fix this please? Where it will only create one document, which is the one I input on the Inputbox. And also I would like to save it as PDF put haven't found how yet. Thanks,

Sorry that some things are in spanish, but I also tried to paste a translated one.

Spanish:

' Declaracion de Variables
Dim carpeta As String
Dim renglon As Integer

' Asignacion de valores a variables
carpeta = InputBox("Copie aquí la dirección de la carpeta destino. Por ejemplo: ", "Carpeta destino", "N:\temp\")
renglon = InputBox("Escriba la fila/renglón que desee usar para generar contratos")
    '
    patharch = ThisWorkbook.Path & "\Prueba Local Plantilla.dotx"
    '
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = True
        objWord.Documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
        '
        For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
            textobuscar = Cells(1, j)
            objWord.Selection.Move 6, -1
            objWord.Selection.Find.Execute FindText:=textobuscar
            '
            While objWord.Selection.Find.found = True
                objWord.Selection.Text = Cells(renglon, j) 'texto a reemplazar
                objWord.Selection.Move 6, -1
                objWord.Selection.Find.Execute FindText:=textobuscar
            Wend
            '
                
        Next
        ruta = carpeta & "\"
        nombd = "Prueba Local Word " & i & ".docx"
        nombp = "Prueba Local PDF " & i & ".pdf"
        objWord.ActiveDocument.SaveAs ruta & nombd
        pdf = objWord.ActiveDocument.ExportAsFixedFormat(nombp, _
            17, False, 0, 0, , , 0, False, True, 1)
        objWord.Quit (True)
    Next
End Sub

English:

'Variables
Dim folder As String
Dim row As Integer

' Asignation
folder = InputBox("Paste here the location you want it to save", "Folder", "N:\temp\")
row = InputBox("Type here the row you want the information to be createds to a document")
    '
    patharch = ThisWorkbook.Path & "\Local Test Template.dotx"
    '
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = True
        objWord.Documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
        '
        For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
            searchtext = Cells(1, j)
            objWord.Selection.Move 6, -1
            objWord.Selection.Find.Execute FindText:=searchtext
            '
            While objWord.Selection.Find.found = True
                objWord.Selection.Text = Cells(renglon, j) 'text to replace
                objWord.Selection.Move 6, -1
                objWord.Selection.Find.Execute FindText:=searchtext
            Wend
            '
                
        Next
        location = folder & "\"
        nombd = "Prueba Local Word " & i & ".docx"
        nombp = "Prueba Local PDF " & i & ".pdf"
        objWord.ActiveDocument.SaveAs location & nombd
        pdf = objWord.ActiveDocument.ExportAsFixedFormat(nombp, _
            17, False, 0, 0, , , 0, False, True, 1)
        objWord.Quit (True)
    Next
End Sub ```

CodePudding user response：

This is happening because you are creating and saving the Word docs inside For i = 2 To Range("A" & Rows.Count).End(xlUp).Row. Place the following lines before the loop starts:

        Set objWord = CreateObject("Word.Application")
        objWord.Visible = True
        objWord.Documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0

And place the following lines after the last Next (referencing Next i (for readability, useful to add the i)):

        location = folder & "\"
        nombd = "Prueba Local Word " & i & ".docx"
        nombp = "Prueba Local PDF " & i & ".pdf"
        objWord.ActiveDocument.SaveAs location & nombd
        pdf = objWord.ActiveDocument.ExportAsFixedFormat(nombp, _
            17, False, 0, 0, , , 0, False, True, 1)
        objWord.Quit (True)