What's wrong with this code?

Question

I'll preface this by saying this is not my code, I got it as a free resource. I don't know the slightest thing about vba macros.

Anyway I'm trying to use this code to populate word templates from an excel file. However when I insert the code it says a couple things are wrong with it.

code

Sub ReplaceText()

Dim wApp As Word.Application <- this line keeps getting 'user defined type not defined ed'

Dim wdoc As Word.Document

Dim custN, path As String

Dim r As Long

r = 2

Do While Sheet1.Cells(r, 1) (not equal to) "" <--- this previous line keeps getting 'complies error, expected list separator or )'

Set wApp = CreateObject("Word.Application")

wApp.Visible = True

Set wdoc = wApp.Documents.Open(Filename:="C:\Users\screa\OneDrive\reconstructionBH\Documents\Excel\welcome.dotx", ReadOnly:=True)

With wdoc

.Application.Selection.Find.Text = "||name||"

.Application.Selection.Find.Execute

.Application.Selection = Sheet1.Cells(r, 1).Value

.Application.Selection.EndOf

.Application.Selection.Find.Text = "||address||"

.Application.Selection.Find.Execute

.Application.Selection = Sheet1.Cells(r, 2).Value

.Application.Selection.EndOf

.Application.Selection.Find.Text = "||city||"

.Application.Selection.Find.Execute

.Application.Selection = Sheet1.Cells(r, 3).Value

.Application.Selection.EndOf

.Application.Selection.Find.Text = "||postal code||"

.Application.Selection.Find.Execute

.Application.Selection = Sheet1.Cells(r, 4).Value

.Application.Selection.EndOf

.Application.Selection.Find.Text = "||name||"

.Application.Selection.Find.Execute

.Application.Selection = Sheet1.Cells(r, 1).Value

.Application.Selection.EndOf

custN = Sheet1.Cells(r, 1).Value

path = "C:\Users\screa\OneDrive\Desktop\invoices\"

.SaveAs2 Filename:=path & custN, \_

FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False

End With

r = r + 1

Loop

End Sub

Please assist thank you!

Answer 1

Hi,

SAMPLE

open word template and create new word documents (docx)

from data in excel file in activesheet

results

all docx files on desktop in a folder

pic1/template

.

pic2/data in excel

.

.

result

file word docx <Kostas>

pic/ folder on desktop

.

===============================

vba code

[Update-1]

Option Explicit ' << START VBA

Dim ws As Worksheet

Dim wdApp As Object

Dim wdDoc As Object

Dim newFd, sPath

Dim x, y

'

Sub Open_wd_Template_Update()

'## 29-09-2024 ##

Dim ws As Worksheet

Set ws = ActiveSheet 'data in active sheet / row2-row4

Application.ScreenUpdating = False

'

'1/ create a folder on desktop <fd-update-wd>

newFd = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\fd-update-wd" '<< create a new Folder

If Dir(newFd, vbDirectory) = Empty Then MkDir newFd

'

'2/ change template path BUT NOT IN ONEDRIVE

sPath = ThisWorkbook.Path & "\template1-wd.dotx" '<< change name

'

'3/ open word app

If wdApp Is Nothing Then

Set wdApp = CreateObject("Word.Application")

Else

Set wdApp = GetObject(, "Word.Application")

End If

wdApp.Visible = True

'

'4/ loop in excel file

For x = 2 To 4

Set wdDoc = wdApp.Documents.Add(Template:=sPath, NewTemplate:=False, DocumentType:=0)

'

'add date today

With wdDoc.Content.Find

.Text = "<<date>>" '<< find what

.Replacement.Text = Format(Date, "dd/mm/yyyy") '<< replace with

.Wrap = wdFindContinue

.MatchWholeWord = True

.Execute Replace:=wdReplaceAll

End With

'

'update table in word doc row2/ 5 cells

For y = 1 To 5

wdDoc.Tables(1).Cell(2, y).Range.Text = ws.Cells(x, y).Value 'name

Next y

'

'4a/ save word-doc as docx on desktop in fd <fd-update-wd>

wdDoc.SaveAs newFd & "" & ws.Cells(x, 1).Value, FileFormat:=wdFormatXMLDocument

wdDoc.Close False

Next x

wdApp.Quit

Application.ScreenUpdating = True

Set wdApp = Nothing

Set wdDoc = Nothing

End Sub ' << END VBA

Answer 2

Hi Christianna

Please, check if the videos below are close to what you are looking for,

Regards

Jeovany

https://youtu.be/0XifMrBegS0

https://youtu.be/w3u8Q45dIec