利用Excel中的信息，根据Word模板批量生成Word文档

需要把Excel中的数据一一填写到Word文档中，而Excel中的数据很长，并且Word文档中只需填写，其他的地方都不需要改动。手工操作实在让人无法忍受（不过，俺却手动完成了一遍，实在是……）。因为以前没有接触过VBS脚本类的东东，所以俺上网搜索了一下，汗，下面就是我的经历了，实在让人郁闷！

首先就是搜索Word正文和Word文档中的文本框里的文本（感觉好绕口）是不同。这里是我绕弯子绕的最多的了，因为以前从来没有接触过，根据就知道，花了我不下6个小时才了解，郁闷之一。
其次是，遍历文档中的文本框内容进行替换时，会丢失格式，目前还没有找到完美的方法，郁闷之二。

有了这两个郁闷，就已经够我喝一壶了，汗（确实喜欢用这个词）。
我的解决方法就是在需要替换的地方新置一个文本框，里面主上一个替换的字眼用以标注和查找替换用。
然后在遍历替换时，查看文本有没有变动。变动则更新文本内容！这就是我的笨方法，运行OK，事情也完成了，不过代码确实不堪！

为了给自己长个记性，把其他的一些用法用注释了，并没有删除掉。

[codes=vb]

‘  通过Excel表格里的信息
‘  使用Word模板批量生成Word文档
‘
‘      Write By IAwen    2010-12-07

infoListXLS=”E:\HR\info_Test.xls”      ‘信息列表Excel文件名
wordTemplate=”E:\HR\template.doc”    ‘Word模块文件名
wordOutputPath=”E:\HR\”          ‘Word文件输出路径

‘打开excel
Set objExcel = CreateObject(“Excel.Application”)
Set objWorkbook = objExcel.Workbooks.Open(infoListXLS)
objExcel.Visible=true

Dim FSO
Set FSO = CreateObject(“Scripting.FileSystemObject”)
  
‘从打开的Excel的第二行开始读取
intRow = 3
‘Const wdReplaceAll  = 2
‘Const wdFindContinue = 1
Const msoTextBox = 17

‘开始循环，直到第3列为空时退出循环
Do Until objExcel.Cells(intRow,3).Value = “”
  ‘取得第3列、第4列内容：编号和公司名称
  num=objExcel.Cells(intRow,3).Value                          
  company=objExcel.Cells(intRow,4).Value
  
  fileName = wordOutputPath & “HR互动邀请信” & num & “.doc”
  FSO.CopyFile wordTemplate, fileName
  
  ‘打开新做成的Word文档，并将姓名跟性别填入Word文档的表格中
  Set objWord = CreateObject(“Word.Application”)
  objWord.Visible = True
  Set objDoc = objWord.Documents.Open(fileName)
    
    ‘遍历文档中的所有文本框
  For Each sharp In objDoc.Shapes
    If sharp.Type=msoTextBox Then
      tmpString=sharp.TextFrame.TextRange.Text
      newString=Replace(tmpString,”##company##”, company)
      If tmpString <> newString Then
        sharp.TextFrame.TextRange.Text = newString
      End If
      
      tmpString=sharp.TextFrame.TextRange.Text
      newString=Replace(tmpString,”##number##”, num)
      If tmpString <> newString Then
        sharp.TextFrame.TextRange.Text = newString
      End If
    End If
  Next
  
  ‘搜索文档正文
  ‘Set objSelection = objWord.Selection
  ‘objSelection.Find.Text = “##company##”      ‘查找的文本
    ‘objSelection.Find.Replacement.Text = company
  ‘objSelection.Find.Forward = True
    ‘objSelection.Find.Wrap = wdFindContinue
    ‘objSelection.Find.Format = False
    ‘objSelection.Find.MatchCase = False
    ‘objSelection.Find.MatchWholeWord = True
    ‘objSelection.Find.MatchWildcards = False
    ‘objSelection.Find.MatchSoundsLike = False
    ‘objSelection.Find.MatchAllWordForms = False
    ‘objSelection.Find.Execute ,,,,,,,,,,wdReplaceAll
  
  ‘保存文件
  objDoc.save()
  Set objDoc=Nothing
  objWord.Quit
  intRow = intRow + 1
Loop

‘退出Excel
objExcel.Quit

测试文档与脚本文件下载：
[file][attach]403[/attach][/file]