【VBS脚本】VBS复制Excel工作簿

近期因为业务的需要，需要做一个批处理复制Excel工作簿到一个汇总Excel里边，由于客户的环境不具备应用其他编程语言如Python等高效开发语言且希望操作越简单越好，因此就采用window原生的语言-VBS，本人也是初学者，望大神们指摘。

1、任何开发都要涉及后期运维，所以程序的执行情况要有据可循，因此第一步生成日志文件

dim logPath

Set wshell = CreateObject("WScript.Shell") '初始化WScript对象

Set objFSO = CreateObject("Scripting.FileSystemObject")'初始化FileSystemObject对象

PathDesktop = wshell.specialfolders("Desktop")'获取本地桌面路径

logPath = PathDesktop+"\脚本日志.txt" '设定日志文件保存路径

'判断本地是否生成日志文件
if not objFSO.FileExists(logPath) then
   Set ObjFolder = objFSO.CreateTextFile(logPath)
end if

Set objFile = objFSO.OpenTextFile(logPath,8)'打开文件，并设定方式为追加（8）

objFile.WriteLine "开始进行作业处理" '根据程序执行情况写入log内容

2、开发过程中出现一些数据结构的应用，因此稍微再写一下

Set Dic = CreateObject("Scripting.Dictionary") '初始化字典结构

Dic.Add key, value '添加键值对key-value到字典中

Dic.Item(columnCValue) '获取键值对key对应的value值，同时也可以改变该key对应的value值

for each key in Dic '遍历对应的字典
    msgBox "key:"&key&" value:"&Dic(key)
Next

3、对Excel的读取和复制处理

Set xlsApp = CreateObject("Excel.Application")

xlsApp.Visible = false '设定Excel是否可见，建议设定成false，可以提升执行效率

xlsApp.DisplayAlerts = False '设定打开Excel是否显示警告窗口，建议设定为false

set excel1 = xlsApp.workbooks.open("此处填写要复制的Excel绝对路径")

set excel2 = xlsApp.workbooks.open("此处填写复制到的Excel绝对路径")	

'>>>纯文本复制（不建议，因为会导致一些文本格式丢失，造成数据缺失）
excel1.Worksheets("此处填写要复制的Excel工作簿").UsedRange.Copy

excel2.Sheets("要被复制的sheet名字").Activate'此处操作前需要生成一个新的sheet （excel2.Worksheets.Add）

excel2.ActiveSheet.Range("A1").PasteSpecial

'>>>带格式复制（优先选择）
set fromSheet = excel1.Worksheets("要复制的sheet名字")

set toSheet = excel2.Worksheets(excel2.Sheets.Count)

fromSheet.Copy toSheet '复制到新的Excel里边会在当前文件中的sheet后边追加新的sheet，且sheet名字为原来复制到sheet的名字

excel2.Sheets("复制的sheet名字").Name = "新的sheet名字" '修改复制后的sheet名字

excel2.save() '保存复制后的Excel文件
set fromSheet = nothing '清空复制sheet对象
set toSheet = nothing '清空复制到sheet对象
excel1.close '关闭Excel1
excel2.close '关闭Excel2

以上，会根据后续业务继续更新！！！