VBA批量生成word(如offer)

Excel里面有客户的名字、身份证、性别、手机号，通过批量更新offer的这4个变量批量生成offer。

VBA代码如下：
Sub CreateWord()
Dim mypath, Newname, i, XB, wApp
mypath = ThisWorkbook.Path & “\”
For i = 2 To [a1048576].End(xlUp).Row
Newname = “offer-” & Range(“a” & i) & “.docx” ‘给新生成的表起个名称
FileCopy mypath & “offer.docx”, mypath & Newname ‘将模板复制并重命名
Set wApp = CreateObject(“word.application”)
With wApp
.Visible = False
.Documents.Open mypath & Newname ‘打开我们复制的新文件进行更改
Do While .Selection.Find.Execute(“名字”) ‘寻找客户这个关键词，将其用表格中的姓名来代替
.Selection.Text = Range(“A” & i).Text
.Selection.HomeKey Unit:=6
Loop

Do While .Selection.Find.Execute(“身份证号”)
.Selection.Text = Range(“B” & i).Text ‘替换字符串
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute(“男女”)
.Selection.Text = Range(“C” & i).Text ‘替换字符串
.Selection.HomeKey Unit:=6
Loop
Do While .Selection.Find.Execute(“手机号”)
.Selection.Text = Range(“D” & i).Text ‘替换字符串
.Selection.HomeKey Unit:=6
Loop

.Documents.Save
.Quit

End With
Next
Set wApp = Nothing

End Sub