vbs 合并多个excel文件的脚本
程序员文章站
2022-04-10 08:12:45
复制代码 代码如下: const xlworkbooknormal = -4143 const xlsavechanges = 1 objstartfolder = "c:...
复制代码 代码如下:
const xlworkbooknormal = -4143
const xlsavechanges = 1
objstartfolder = "c:\test" '要读取的源文件目录
desexcel= "c:\result1.xls" '最后生成的汇总excel
set excelapp = createobject("excel.application")
set destbook = excelapp.workbooks.add '创建空文件
set objfso = createobject("scripting.filesystemobject")'建立filesystemobject
set objfolder = objfso.getfolder(objstartfolder)'获取文件夹
set colfiles = objfolder.files '获得源目录下所有文件
introw=1 '行数
for each objfile in colfiles '依次处理文件夹中的文件
if ucase(right(trim(objfile.name), 3)) ="xls" then '只处理xls文件
set srcbook = excelapp.workbooks.open(objstartfolder + "\" + objfile.name) '打开xls文件
'srcbook.worksheets(1).copy destbook.worksheets(1)
srcbook.activate
intcol = 1 '列数
do until excelapp.cells(1,intcol).value = ""
tempdata=excelapp.cells(1, intcol).value
destbook.activate
excelapp.cells(introw, intcol).value=tempdata
srcbook.activate
intcol = intcol + 1
loop
srcbook.close '关闭已经打开的xls文件
end if
introw=introw+1
next
destbook.saveas desexcel,xlworkbooknormal
destbook.close xlsavechanges
excelapp.quit
這個方法ok
在存放文件的目录之外打开一个空的excel文档
运行下面分宏:(注意文件目录)
复制代码 代码如下:
sub cfl()
dim fs, f, f1, fc, s, x
set fs = createobject("scripting.filesystemobject")
set f = fs.getfolder("e:\test\") '存放文件的目录
set fc = f.files
for each f1 in fc
if right(f1.name, 3) = "xls" then
x = x + 1
workbooks.open (f1.path)
for i = 1 to 255
workbooks(1).sheets(1).cells(x, i).value = _
workbooks(2).sheets(1).cells(1, i).value
next
workbooks(2).close savechanges:=false
end if
next
end sub
上一篇: vbs删除注册表项的代码