VBS脚本搞定，快速批量提取一堆Excel文件中的数据

1.需求诞生

小王就职于一家国有大型企业，工作业务十分繁忙，在处理企业某业务数据时，需要从上千个Excel文件中提取某一单元格位置的数据，并整理到另一个Excel文件。要说是这样的Excel文件仅有几个或者十几个也还好，手动点开复制粘贴并不是难事。

但是面对一下子上千个的文件，要靠人工操作恐怕是非常不现实的，小王顿感到十分地为难。好在，他这时候想到了自己的好朋友“八两”。八两听完了小王的介绍，知道这样的需求肯定是可以软件实现的，于是对小王说，你把文件发给我吧，我下班回家后写代码帮你提取数据。可是小王却说，这些文件涉及到企业核心经营数据，实在不方便提供。于是问题暂时陷入了僵局。

2.实现思路

小王不懂代码，更不会编写软件，无法提供Excel文件肯定是不方便调试的，所以凭空写一个应用程序发给小王，万一遇到软件有Bug的地方也不便于调试。好在还有一种编程语言叫做脚本语言，比如说VBS，VBS的脚本程序扩展名即为.vbs，使用记事本文件可以直接编写，保存后还可以双击直接在Windows系统上运行，遇到异常的话，远程指导小王修改其中的脚本代码也相对容易。于是八两决定使用记事本来完成这样一件任务。

3.核心代码

废话不多说，直接贴出全部脚本代码。

' 定义文件夹路径
Dim folderPath
folderPath = "D:\YourFolderPath\"
' 定义目标 Excel 文件路径
Dim targetExcelPath
targetExcelPath = "D:\YourTargetExcel.xlsx"
' 打开文件夹
Set folder = CreateObject("Scripting.FileSystemObject").GetFolder(folderPath)
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True ' 设置Excel可见
Set targetWorkbook = objExcel.Workbooks.Open(targetExcelPath)
Set targetWorksheet = targetWorkbook.Worksheets(1)
' 遍历文件夹中的 Excel 文件
dim row,col
' row，col是定义写入位置的初始位置，行和列号
row=1
col=1
For Each file In folder.Files
	If LCase(Right(file.Name, 4)) = ".xls" Or LCase(Right(file.Name, 5)) = ".xlsx" Then
		' 打开 Excel 文件
		Set workbook = objExcel.Workbooks.Open(file.Path)
		' 选择要提取数据的工作表
		Set worksheet = workbook.Worksheets(1)
		' 提取相同位置的数据
		Dim dataToExtract
        ' 这句的1,1是指读取文件中要读取数据的 位置是第1行第1列。
		dataToExtract = worksheet.Cells(1, 1).Value
		' 将数据写入目标表格
		targetWorksheet.Cells(row, col) = dataToExtract
		row=row+1
		' 关闭打开的 Excel 文件
		workbook.Close
	End If
Next
' 显示完成消息
MsgBox "数据提取完成！"

注意，这里的代码用记事本保存时，编码一定要选择为ANSI，如果保存为UTF-8或者其他编码格式，运行是会报错的。保存时，保存类型选择为“所有文件(*.*)”，文件名为“提取数据.vbs”即可。

4.完整文件

普通脚本文件而已，大家复制保存后，修改运行即可，就不上传单独的文件了。