vbs 合并 excel 表格

项目进入到要测试数据的阶段了。

从数据库导出一堆 excel 表，但看它们就这样散着真不舒服。所以合并一下吧。

在网上搜了半天，竞然都没有找到现成通用的VBS脚本，真坑爹。只能自己来了。

Dim source_XLS,final_XLS_name,fileConut

'----------------------------------- 配置参数 ---------------------------------
'这里是文件名，想要什么直接改引号中间的文字就行了
xls_name  = "数据统计表"
'------------------------------------------------------------------------------

'----------准备文件操作----------
Set fso = CreateObject("Scripting.FileSystemObject")

'----------准备WshShell----------
Set WshShell=WScript.CreateObject("Wscript.Shell")

'----------准备excel对象----------
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = 0

'vbs 所在目录
XLSFolder = WshShell.CurrentDirectory
'文件名自动加日期后缀
final_XLS_name = "\"&xls_name&"_"&Date

'清理旧表(vbs 模糊删除太麻烦，所以调用命令行)
'fso.DeleteFile(xls_name&"*") 
WshShell.run  "%Comspec% /C DEL "&xls_name&"*.*",0

'调用
ProcessAllFiles XLSFolder

'-----------打完收功----------------
oExcel.Quit

MsgBox "成功合并【"& fileConut & "】个表格" ,0+64-64+256,"合并 Excel 表格！"

'* 遍历文件夹
'******************************
Function ProcessAllFiles(folderspec)        
	Dim fd, fs, f
	Set fd = fso.GetFolder(folderspec)
	Set fs = fd.Files
	
	Dim Workbook_to,Workbook_form
	
	Set Workbook_to = oExcel.Workbooks.Add
	
	oExcel.DisplayAlerts = False	
	
	For Each f In fs
		If UCase(Right(f.Path, 4)) = ".XLS" Or UCase(Right(f.Path, 5)) = ".XLSX" Then
			Set Workbook_form = oExcel.Workbooks.Open(f.Path, 0, True)
			
			'改 sheet 名字，只留中文部分
			sheetName = Workbook_form.Worksheets(1).name
			tempName = Split(sheetName,"_")
			Workbook_form.Worksheets(1).name  = tempName(UBound(tempName))    		
			
			'移动sheet
			Workbook_form.Worksheets(1).move Workbook_to.Worksheets(1)
			
			Workbook_form.Close 	
			fileConut = fileConut+1
			WshShell.Popup "成功合并: "&f.Name, 1, "合并 Excel 表格！", 0 + 32
		End If
	Next
	
	'删除默认的 sheet1
	Workbook_to.Worksheets("Sheet1").Delete 
			
	Workbook_to.SaveAs fd & final_XLS_name
	Workbook_to.Close 	
	
	oExcel.displayalerts=True	
	oExcel.Quit
	
End Function