VBS 从Excel中获取数据,批量替换word中的文字

简介

比如我有一个需求,需要把一份 word 中的英文国家名全部替换成中文国家名,excel中的第一列是英文国家名,第二列是中文国家名。人工完成的话,费时费力,使用我编写的程序,双击一下,瞬间完成。

文章目录

  • 简介
  • 效果图
    • 处理前
    • 处理后
  • 源码
  • 使用说明
  • 参考资料

效果图

处理前

VBS 从Excel中获取数据,批量替换word中的文字_第1张图片

处理后

VBS 从Excel中获取数据,批量替换word中的文字_第2张图片

源码

Const wdReplaceAll = 2
Dim arrSheet()
Dim nUsedRows, nUsedCols
Dim wordPath, exelPath
 
 '将下面这一行代码的双引号中的内容替换成你的word文档地址
wordPath = ("D:\Tecent\QQFile\123.docx")
 '将下面这一行代码的双引号中的内容替换成你的excel文档地址
exelPath = ("D:\Tecent\QQFile\123.xlsx")

Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open(wordPath)
Set objSelection = objWord.Selection

objSelection.Find.Forward = TRUE
objSelection.Find.MatchWholeWord = TRUE

ReadExcelFile(exelPath)

for i=0 to nUsedRows-1
   objSelection.Find.Text = arrSheet(i,0)
   objSelection.Find.Replacement.Text = arrSheet(i,1)
   objSelection.Find.Execute ,,,,,,,,,,wdReplaceAll
next

Function ReadExcelFile(ByVal strFile)

  ' Local variable declarations
  Dim objExcel, objSheet, objCells
  Dim nTop, nLeft, nRow, nCol

  ' Default return value
  ReadExcelFile = Null

  ' Create the Excel object
  On Error Resume Next
  Set objExcel = CreateObject("Excel.Application")
  If (Err.Number <> 0) Then
    Exit Function
  End If

  ' Don't display any alert messages
  objExcel.DisplayAlerts = 0  

  ' Open the document as read-only
  On Error Resume Next
  Call objExcel.Workbooks.Open(strFile, False, True)
  If (Err.Number <> 0) Then
    Exit Function
  End If

  ' If you wanted to read all sheets, you could call
  ' objExcel.Worksheets.Count to get the number of sheets
  ' and the loop through each one. But in this example, we
  ' will just read the first sheet.
  Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

  ' Get the number of used rows
  nUsedRows = objSheet.UsedRange.Rows.Count

  ' Get the number of used columns
  nUsedCols = objSheet.UsedRange.Columns.Count

  ' Get the topmost row that has data
  nTop = objSheet.UsedRange.Row

  ' Get leftmost column that has data
  nLeft = objSheet.UsedRange.Column

  ' Get the used cells
  Set objCells = objSheet.Cells

  ' Dimension the sheet array
  ReDim arrSheet(nUsedRows - 1, nUsedCols - 1)

  ' Loop through each row
  For nRow = 0 To (nUsedRows - 1)
    ' Loop through each column
    For nCol = 0 To (nUsedCols - 1)
  ' Add the cell value to the sheet array
  arrSheet(nRow, nCol) = objCells(nRow + nTop, nCol + nLeft).Value
    Next
  Next

  ' Close the workbook without saving
  Call objExcel.ActiveWorkbook.Close(False)

  ' Quit Excel
  objExcel.Application.Quit

  ' Return the sheet data to the caller
  ReadExcelFile = arrSheet

End Function

使用说明

  1. excel 表格的 A 列是待替换内容,B 列是替换后的内容
  2. 新建txt文档,复制粘贴源码,将代码中第7行的 wordPath 的值修改为你的word文档的路径地址。将代码中第9行的 exelPath 的值修改为你的 excel 文档的路径地址。
  3. 修改文档后缀为VBS,点确认。修改完成后,你将得到一个xxx.VBS的可执行程序,双击即可完成替换操作。
  4. 后续有什么问题,可在评论区留言。我看到后会尽快回复。

参考资料

《How Can I Replace Text in a Microsoft Word Document?》
https://blogs.technet.microsoft.com/heyscriptingguy/2006/08/08/how-can-i-replace-text-in-a-microsoft-word-document/
《Reading Excel Files》
https://developer.rhino3d.com/guides/rhinoscript/reading-excel-files/

你可能感兴趣的:(VBS)