根据给定的word模板将Excel表格数据批量写入word

Sub ExcelDataWriteInWord(sourceArr, MaxCol, wordModelName)
'根据给定的word模板将Excel表格数据批量写入word
'参数说明
'sourceArr 要写入word的数据源数组
'MaxCol 最大列号
'wordModelName word模板的名称
Dim wordObj As New Word.Application, currentPath$
Dim exportFolderName$, exportPathFolderName$, i, j, Str1, Str2
'currentPath = "F:\A.和美外账-TimeNode-Day15\n.社保异动表格编制_勿移动"
currentPath = ThisWorkbook.path
For i = 1 To UBound(sourceArr)
'exportFolderName = "劳动合同书"
exportFolderName = wordModelName
FileCopy currentPath & "\劳动合同书(模板).doc", currentPath & "\" & exportFolderName & "(" & sourceArr(i, 1) & ").doc"
exportPathFolderName = currentPath & "\" & exportFolderName & "(" & sourceArr(i, 1) & ").doc"
KillAlreadyExistsWordFile (exportPathFolderName) '删除已经存在的word文件
FileCopy currentPath & "\劳动合同书(模板).doc", currentPath & "\" & exportFolderName & "(" & sourceArr(i, 1) & ").doc"
exportPathFolderName = currentPath & "\" & exportFolderName & "(" & sourceArr(i, 1) & ").doc"
With wordObj
.Documents.Open exportPathFolderName
.Visible = False
'For j = 1 To 4 '填写文字数据
For j = 1 To MaxCol '填写文字数据
Str1 = "data" & Format(j, "000")
Str2 = sourceArr(i, j)
.Selection.HomeKey Unit:=wdStory '光标置于文件首
If .Selection.Find.Execute(Str1) Then '查找到指定字符串
.Selection.Font.Color = wdColorAutomatic '字符为自动颜色
.Selection.Text = Str2 '替换字符串
End If
Next j
End With
wordObj.Documents.Save
wordObj.Quit
Set wordObj = Nothing
Next
End Sub
Sub KillAlreadyExistsWordFile(path)
If Dir(path) <> "" Then Kill path
End Sub