目录
第六章：VBScript语言实现通用控制
6-1 VBScript语言的使用方法
6-2 在VBS中操作Word文件
6-3 VBS实例-1（将指定文件夹下的图片信息提取到Word表格-1）
6-4 读取Excel数据写入到Word
6-5 读取Word数据写入到Excel
6-6 Excel通用功能实例（拆分工作簿）
第六章：VBScript语言实现通用控制
6-1 VBScript语言的使用方法
VBScript是Visual Basic Script的简称，即 Visual Basic 脚本语言，有时也被缩写为VBS。它是一种微软环境下的轻量级的解释型语言。
VBScript生成的文件扩展名为vbs。
这里我们使用的是记事本来完成代码的编辑。在保存时注意编码方式的选择，最好为ANSI。
VBS的代码中不需要sub和end sub
在vbs中能运行的代码，在VBA中一定能运行
在VBA中能运行的代码，在VBS中不一定能运行，必须去掉VBA中特有的代码，比如：thisdocument、dimdoc as document、dir、Selection等
在记事本中写入如下代码，保存为vbs文件，运行：
Fori = 1 To 3
MsgBox i
Next
6-2在VBS中操作Word文件
在vbs中操作word文件，跟在Word VBA中写的代码基本相似。
在记事本中写入如下代码（要去掉注释符），保存为vbs文件，运行：
DimdocAPP, docFile, docOpen
SetdocAPP = CreateObject("word.application")
docAPP.Visible = True
SetdocFile = docAPP.Documents.Add
With docFile
.Range(0).Text = "Word VBA"
.SaveAs2 "e:\demo.docx"
.Close
End With
SetdocOpen = docAPP.Documents.Open("e:\test.docx")
MsgBox docOpen.Range(0, 11)
docOpen.Close
docAPP.Quit
SetdocAPP = Nothing
6-3 VBS实例-1（将指定文件夹下的图片信息提取到Word表格-1）
Sub将指定文件夹下的图片信息提取到Word表格()
Setfso = CreateObject("scripting.filesystemobject")'创建一个文件系统对象（fso）
Setfd = fso.GetFolder("E:\Word VBA学习笔记\照片")'获取文件夹
SetdocAPP = CreateObject("word.application")
Setdoc = docAPP.Documents.Add
SettabObj = doc.Tables.Add(doc.Range, fd.Files.Count + 1, 3, 1)
tabObj.Cell(1, 1).Range.Text = "序号"
tabObj.Cell(1, 2).Range.Text = "图片名"
tabObj.Cell(1, 3).Range.Text = "图片"
num = 1
ForEachf In fd.Files
num = num + 1
tabObj.Cell(num, 1).Range.Text = num - 1
tabObj.Cell(num, 2).Range.Text = Split(f.Name, ".")(0)
tabObj.Cell(num, 3).Range.InlineShapes.AddPicture (f.Path)'插入图片
Next
doc.SaveAs2 "E:\Word VBA学习笔记\提取结果.docx"
docAPP.Quit
SetdocAPP = Nothing
End Sub
在记事本中写入如下代码（要去掉注释符），保存为vbs文件，运行：
Setfso = CreateObject("scripting.filesystemobject")'创建一个文件系统对象（fso）
Setfd = fso.getfolder("E:\Word VBA学习笔记\照片")'获取文件夹
SetdocAPP = CreateObject("word.application")
Setdoc = docAPP.Documents.Add
SettabObj = doc.Tables.Add(doc.Range, fd.Files.Count + 1, 3, 1)
tabObj.Cell(1, 1).Range.Text = "序号"
tabObj.Cell(1, 2).Range.Text = "图片名"
tabObj.Cell(1, 3).Range.Text = "图片"
Num = 1
ForEachf In fd.Files
Num = Num + 1
tabObj.Cell(Num, 1).Range.Text = Num - 1
tabObj.Cell(Num, 2).Range.Text = Split(f.Name, ".")(0)
tabObj.Cell(Num, 3).Range.InlineShapes.AddPicture (f.Path)'插入图片
Next
doc.SaveAs2 "E:\Word VBA学习笔记\提取结果.docx"
docAPP.Quit
SetdocAPP = Nothing
在工具-引用中加载“Microsoft Scripting runtime”，就可以引用filesystemobject对象，输入代码时有代码提示
字典对象，也是加载“Microsoft Scripting runtime”
下面申明一个filesystemobject以作研究：
Subfilesystemobject对象()
Dimfso As New filesystemobject
'fso.MoveFile "C:\Users\Administrator\Desktop\a.vbs", "C:\Users\Administrator\Desktop\a.txt" 'MoveFile可以重命名文件
Setfs = fso.GetFile("C:\Users\Administrator\Desktop\新建文件夹\td001\0001.jpg")
Setfd = fso.GetFolder("C:\Users\Administrator\Desktop\新建文件夹")
ForEachf In fd.Files
Debug.Print f.Name
Next
End Sub
6-4读取Excel数据写入到Word
'把下面代码（去除sub与end sub）复制到记事本中，保存为vbs运行即可
Sub读取Excel数据写入到Word()
SetdocAPP = CreateObject("word.application")
docAPP.Visible = True
Setdoc = docAPP.Documents.Add
Sett = doc.Tables.Add(doc.Range(0), 2, 6, 1)'创建2行6列有网格的表格
t.Cell(1, 1).Range.Text = "姓名"
t.Cell(1, 2).Range.Text = "第1季度"
t.Cell(1, 3).Range.Text = "第2季度"
t.Cell(1, 4).Range.Text = "第3季度"
t.Cell(1, 5).Range.Text = "第4季度"
t.Cell(1, 6).Range.Text = "总计"
SetxlApp = CreateObject("excel.application")
xlApp.Visible = True
Setwb = xlApp.Workbooks.Open("E:\Word VBA学习笔记\6-5.xlsx")
Setws = wb.Sheets("业绩表")
a = ws.usedrange.Rows.Count
Fori = 2 To a
Ifws.Cells(i, "f").Value >= 6000000Then
intlast = t.Rows.Last.Index
t.Rows.Add t.Rows(intlast)'在最后一行的前面插入一行
t.Cell(intlast, 1).Range.Text = ws.Cells(i, "a").Value
t.Cell(intlast, 2).Range.Text = ws.Cells(i, "b").Value
t.Cell(intlast, 3).Range.Text = ws.Cells(i, "c").Value
t.Cell(intlast, 4).Range.Text = ws.Cells(i, "d").Value
t.Cell(intlast, 5).Range.Text = ws.Cells(i, "e").Value
t.Cell(intlast, 6).Range.Text = ws.Cells(i, "f").Value
End If
Next
doc.SaveAs2 "E:\Word VBA学习笔记\结果.docx"
docAPP.Quit
SetdocAPP = Nothing
xlApp.Quit
SetxlApp = Nothing
End Sub
6-5读取Word数据写入到Excel
'把下面代码（去除sub与end sub）复制到记事本中，保存为vbs运行即可
Word表格中的数据如下：
产品数量
a 23
b 58
a 41
b 29
c 88
c 102
a 34
Sub读取Word数据写入到Excel()
Setdic = CreateObject("scripting.dictionary")
SetdocAPP = CreateObject("word.application")
Setdoc = docAPP.Documents.Open("E:\Word VBA学习笔记\销售表.docx")
Sett = doc.Tables(1)
Fori = 2 To t.Rows.Count
cp = Split(t.Cell(i, 1).Range.Text, Chr(13))(0)
sl = Split(t.Cell(i, 2).Range.Text, Chr(13))(0)
dic(cp) = dic(cp) + Int(sl)
Next
SetxlApp = CreateObject("excel.application")
Setwb = xlApp.Workbooks.Add
Setws = wb.Sheets(1)
ws.Range("a1:b1") = Array("产品", "总数量")
ws.Range("a2").Resize(dic.Count, 2) = xlApp.Transpose(Array(dic.keys, dic.items))
wb.SaveAs "E:\Word VBA学习笔记\销售表.xlsx"
docAPP.Quit
xlApp.Quit
SetdocAPP = Nothing
SetxlApp = Nothing
End Sub
6-6 Excel通用功能实例（拆分工作簿）
将一个有很多工作表的工作簿拆分为只有一个工作表的工作簿
'把下面代码（去除sub与end sub）复制到记事本中，保存为vbs运行即可
SubExcel通用功能实例拆分工作簿()
strPath = InputBox("请输入要拆分的Excel文件路径")
strSavePath = InputBox("请输入拆分后保存的路径")
SetxlApp = CreateObject("excel.application")
Setwb = xlApp.Workbooks.Open(strPath)
ForEachws In wb.Sheets
ws.Copy'工作表复制之后，会自动出现在新的工作簿，并且新的工作簿为活动工作簿
xlApp.ActiveWorkbook.SaveAs strSavePath & "\" & ws.Name & ".xlsx"
xlApp.ActiveWorkbook.Close
Next
xlApp.Quit
SetxlApp = Nothing
End Sub
计算机科学与技术 & 计算机网络技术：双专业课程体系完全导航指南
本系列目录
1、Word VBA编程入门指南：从对象模型、流程控制到数组与字典的完整教程
2、Word VBA 对象模型精讲：从Document到Character的文本逐级控制与自动化实战
3、Word VBA 表格自动化实战：从宏录制到Table对象，掌握多表合并与批量生成
4、Word VBA 图形与图表自动化：从批量生成到环形阵列，掌握文档可视化排版
5、Word与Excel VBA协同实战：构建双向数据通道，实现跨软件流程自动化
6、VBScript办公自动化实战：无需打开Office，用独立脚本操作Word与Excel
7、VBScript系统级自动化：使用WScript对象外部操控Office与模拟键盘输入
