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

比眉伴天荒 2023-01-06 11:42 346阅读 0赞

近期因为业务的需要，需要做一个批处理复制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

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