VBS 办公自动化实战：Excel 报表、批量邮件、文件整理，每天省 2 小时

✍️作者王文峰外号神秘小峯 / 山峯中国国学、传统文化与代码爱好者的程序人生期待你的关注和支持vb 的小脚本解决大问题场景篇——办公与运维实战一、开篇场景篇的六个痛点二、场景 1文件批量整理器FSO三、场景 2Excel 报表自动汇总COM 自动化四、场景 3Outlook 自动发日报五、场景 4系统巡检脚本WMI六、场景 5日志清理与压缩定时任务七、场景 6批量网络连通性探测ping 扫描八、工程化把散脚本变成工具箱九、避坑清单场景篇 8 条十、总结与自测清单 学习教程传送门 往期文章 《vb 的小脚本解决大问题》系列的前三篇讲了语法基础、好玩小程序、注册表运维这篇是场景篇把 VBS 放进真实的办公和运维场景里——文件批处理、Excel 报表自动化、Outlook 日报、系统巡检、日志清理、批量连通性检测。六个脚本全部完整可跑每个都标好能省多少时间。VBS 的核心优势依然稳定Windows 自带、双击即跑、COM 自动化无所不能——在 Windows 办公环境里它依然是最快落地的自动化。一、开篇场景篇的六个痛点#痛点手工耗时脚本方案本篇小节1下载/收件文件夹堆积手工分类每天 15 分钟FSO 自动归类场景 12Excel 日报手工汇总十几个文件每天 30 分钟COM 自动化合并场景 23每天手工写邮件发日报每天 15 分钟Outlook 自动发送场景 34服务器手工查 CPU/磁盘/服务每次 10 分钟巡检脚本出报告场景 45日志目录越滚越大手工清理每周 20 分钟定时清理 压缩场景 56批量机器网络通不通手工 ping每次 10 分钟批量探测出清单场景 6VBS 的定位不和 Python 抢通用脚本的活儿它赢在零安装、双击运行、深度集成 Windows/Office——办公自动化和 Windows 运维它依然是最快的刀。二、场景 1文件批量整理器FSO痛点下载文件夹里图片、表格、文档、压缩包混作一团。方案按扩展名自动归类 同名防覆盖 处理清单日志。 文件批量整理器 tidy.vbs —— 按类型归类双击即跑 用法把本脚本放到目标文件夹或修改 srcDir 路径后运行 Option Explicit Dim fso, folder, file, srcDir, destDir, category, target Dim dict, ext, count srcDir C:\Users\Public\Downloads ← 要整理的目录 destDir C:\Users\Public\Downloads\分类结果 ← 归类输出目录 Set fso CreateObject(Scripting.FileSystemObject) Set dict CreateObject(Scripting.Dictionary) 类型映射表扩展名 → 分类 dict.Add jpg, 图片 dict.Add jpeg, 图片 dict.Add png, 图片 dict.Add gif, 图片 dict.Add doc, 文档 dict.Add docx, 文档 dict.Add xls, 报表 dict.Add xlsx, 报表 dict.Add pdf, 文档 dict.Add zip, 压缩包 dict.Add rar, 压缩包 If Not fso.FolderExists(srcDir) Then WScript.Echo 目录不存在 srcDir WScript.Quit 1 End If Set folder fso.GetFolder(srcDir) count 0 For Each file In folder.Files ext LCase(fso.GetExtensionName(file.Name)) 分类映射表里没有的归其他隐藏文件跳过 If dict.Exists(ext) Then category dict(ext) Else category 其他 End If 拼目标目录并确保存在 target destDir \ category If Not fso.FolderExists(target) Then fso.CreateFolder target 同名防覆盖加序号后缀 Dim newName, base, i base fso.GetBaseName(file.Name) newName file.Name i 1 Do While fso.FileExists(target \ newName) newName base _ i . ext i i 1 Loop file.Move target \ newName count count 1 Next WScript.Echo 整理完成共移动 count 个文件到 destDir工程要点①Dictionary做映射表加新类型只改表不改逻辑②同名防覆盖用序号后缀批量脚本的第一原则不能丢用户文件③脚本自带Option Explicit变量必须声明防拼写错。三、场景 2Excel 报表自动汇总COM 自动化痛点每天收到 10 个部门的日报同模板 xlsx手工逐个打开、复制、汇总。方案Excel COM 自动化——批量打开、逐行汇总到总表、算合计、存盘。 Excel 日报汇总 merge_excel.vbs 功能把 sourceDir 下所有 *.xlsx 的数据表 A2:E100 汇总到总表 Option Explicit Dim fso, folder, file, excel, book, summary, row, srcDir, outPath Dim srcBook, srcSheet, lastRow, total srcDir C:\Work\日报 outPath C:\Work\日报汇总.xlsx Set fso CreateObject(Scripting.FileSystemObject) If Not fso.FolderExists(srcDir) Then WScript.Echo 日报目录不存在 srcDir WScript.Quit 1 End If ① 启动 Excel不显示界面 Set excel CreateObject(Excel.Application) excel.Visible False excel.DisplayAlerts False 覆盖保存不弹确认框 On Error Resume Next 单个文件出错不中断整体 Set summary excel.Workbooks.Add() summary.Sheets(1).Name 汇总 写表头 summary.Sheets(1).Range(A1:F1).Value Array(部门, 日期, 项目, 数量, 金额, 备注) row 2 Set folder fso.GetFolder(srcDir) For Each file In folder.Files If LCase(fso.GetExtensionName(file.Name)) xlsx Then Set srcBook excel.Workbooks.Open(file.Path, 0, True) 只读打开 If Err.Number 0 Then Set srcSheet srcBook.Sheets(数据) lastRow srcSheet.Cells(srcSheet.Rows.Count, 1).End(-4162).Row xlUp If lastRow 2 Then ② 批量拷贝 A2:E{lastRow}整块拷比逐格快百倍 srcSheet.Range(A2:E lastRow).Copy summary.Sheets(1).Cells(row, 1).PasteSpecial -4163 xlPasteValues row row lastRow - 1 End If srcBook.Close False Else WScript.Echo 跳过异常文件 file.Name ( Err.Description ) Err.Clear End If End If Next On Error Goto 0 ③ 合计行 列宽自适应 保存 summary.Sheets(1).Cells(row, 1).Value 合计 summary.Sheets(1).Cells(row, 4).Formula SUM(D2:D row - 1 ) summary.Sheets(1).Cells(row, 5).Formula SUM(E2:E row - 1 ) summary.Sheets(1).Columns(A:F).AutoFit summary.SaveAs outPath summary.Close True excel.Quit Set excel Nothing WScript.Echo 汇总完成 outPath 共 row - 2 行数据工程要点①整块Copy/PasteSpecial而非逐格写10 个文件从 2 分钟提速到几秒②On Error Resume Next只包单文件处理坏文件跳过不中断全局③收尾必excel.Quit 释放对象——不释放 Excel 进程会驻留任务管理器COM 自动化第一坑④DisplayAlerts False防弹窗卡住脚本。四、场景 3Outlook 自动发日报痛点汇总完还要写邮件、加附件、抄送领导。方案汇总脚本跑完后无缝发信。 自动发送日报 send_daily.vbsOutlook COM 自动化 Option Explicit Dim outlook, mail, subject, body, attach subject 【日报】 Year(Date) - Right(0 Month(Date), 2) - Right(0 Day(Date), 2) 数据汇总 body 各位领导好 vbCrLf vbCrLf _ 今日数据汇总见附件请查收。 vbCrLf vbCrLf _ ——本邮件由脚本自动发送如有疑问请联系王文峰 Set outlook CreateObject(Outlook.Application) Set mail outlook.CreateItem(0) 0 olMailItem With mail .To leadercompany.com .CC teamcompany.com .Subject subject .Body body .Attachments.Add C:\Work\日报汇总.xlsx 挂上汇总表 .Send 直接发送测试期改 .Display 人工确认 End With Set mail Nothing Set outlook Nothing WScript.Echo 日报已发送工程要点①测试期用.Display弹出草稿人工确认稳定后再改.Send自动化发信务必先肉眼验证过内容②邮件正文加自动发送标识出问题好追溯③Outlook COM 依赖本机登录 Outlook无人值守服务器上要考虑这个前提。五、场景 4系统巡检脚本WMI痛点每天手工查 CPU、内存、磁盘、服务状态多台机器更痛苦。方案WMI 采集 生成巡检报告txt。 系统巡检 check_sys.vbs —— 输出巡检报告 Option Explicit Dim wmi, item, report, fso, outFile, path, freeGB, totalGB, svc path C:\Work\巡检报告_ Year(Date) Right(0 Month(Date), 2) Right(0 Day(Date), 2) .txt Set fso CreateObject(Scripting.FileSystemObject) Set outFile fso.CreateTextFile(path, True) outFile.WriteLine 系统巡检报告 Now outFile.WriteLine 计算机名 CreateObject(WScript.Network).ComputerName outFile.WriteLine ① CPU 负载 Set wmi GetObject(winmgmts:\\.\root\cimv2) For Each item In wmi.ExecQuery(SELECT LoadPercentage FROM Win32_Processor) outFile.WriteLine CPU 负载 item.LoadPercentage % Next outFile.WriteLine ② 内存 For Each item In wmi.ExecQuery(SELECT TotalVisibleMemorySize,FreePhysicalMemory FROM Win32_OperatingSystem) totalGB FormatNumber(item.TotalVisibleMemorySize / 1048576, 2) freeGB FormatNumber(item.FreePhysicalMemory / 1048576, 2) outFile.WriteLine 内存总量 totalGB GB空闲 freeGB GB Next outFile.WriteLine ③ 磁盘剩余空间低于 15% 标红提示 For Each item In wmi.ExecQuery(SELECT DeviceID,Size,FreeSpace FROM Win32_LogicalDisk WHERE DriveType3) totalGB FormatNumber(item.Size / 1073741824, 2) freeGB FormatNumber(item.FreeSpace / 1073741824, 2) Dim flag If (item.FreeSpace / item.Size) 0.15 Then flag ★空间告警 Else flag outFile.WriteLine 磁盘 item.DeviceID 总量 totalGB GB剩余 freeGB GB flag Next outFile.WriteLine ④ 关键服务状态 For Each svc In wmi.ExecQuery(SELECT Name,State FROM Win32_Service WHERE StartModeAuto AND StateRunning) outFile.WriteLine ★ 服务异常 svc.Name 当前状态 svc.State Next outFile.WriteLine outFile.WriteLine 巡检结束 outFile.Close WScript.Echo 巡检完成报告 path工程要点①Win32_*是 WMI 的系统信息宝库CPU/内存/磁盘/服务全在②异常才突出空间 15% 加 ★、非运行服务单列——巡检报告的价值在异常不在正常③文件名带日期历史报告可追溯。六、场景 5日志清理与压缩定时任务痛点应用日志目录几十 GB 滚动堆积手工清理又怕删错。方案只删超过 N 天的 .log先写删除清单日志再动手安全三原则白名单、留痕、先记录后删除。 日志清理 clean_log.vbs —— 清理 logDir 下 N 天前的 .log 文件 用法wscript clean_log.vbs配合计划任务每日凌晨运行 Option Explicit Dim fso, folder, file, logDir, keepDays, cutoff, count, recycleBin logDir D:\App\logs keepDays 7 ← 保留天数按需改 cutoff DateAdd(d, -keepDays, Date) 只删 cutoff 之前的 Set fso CreateObject(Scripting.FileSystemObject) If Not fso.FolderExists(logDir) Then WScript.Quit 0 Set folder fso.GetFolder(logDir) count 0 写删除清单留痕删了什么、何时删的、多大 Dim delLog Set delLog fso.OpenTextFile(logDir \清理记录.txt, 8, True) 8 追加模式 delLog.WriteLine ---- 清理任务 Now 保留 keepDays 天---- For Each file In folder.Files 白名单只动 .log且日期达标用修改日期 If LCase(fso.GetExtensionName(file.Name)) log And file.DateLastModified cutoff Then delLog.WriteLine 删除 file.Name FormatNumber(file.Size / 1024, 1) KB最后修改 file.DateLastModified file.Delete True count count 1 End If Next delLog.WriteLine 本次共清理 count 个文件 delLog.Close Set delLog Nothing 配合计划任务schtasks /create /tn 日志清理 /tr wscript D:\Scripts\clean_log.vbs /sc daily /st 02:00工程要点①白名单策略只删.log后缀绝不删一切旧文件②删除前先写清单出事能查删了什么③用DateLastModified修改时间而非创建时间判旧④脚本注释里给好schtasks计划任务命令——单次清理没价值定时自动才是省时间。七、场景 6批量网络连通性探测ping 扫描痛点几十台服务器/设备通不通要一个个 ping。方案批量探测 出清单超时阈值可调。 批量连通性检测 ping_all.vbs —— hosts.txt 每行一个主机名/IP Option Explicit Dim wmi, shell, host, hosts, fso, inFile, outFile, result, okCount, failCount Set fso CreateObject(Scripting.FileSystemObject) Set shell CreateObject(WScript.Shell) Set wmi GetObject(winmgmts:\\.\root\cimv2) Set inFile fso.OpenTextFile(C:\Work\hosts.txt, 1) 1 只读 Set outFile fso.CreateTextFile(C:\Work\连通性报告.txt, True) okCount 0 : failCount 0 outFile.WriteLine 连通性检测 Now Do Until inFile.AtEndOfStream host Trim(inFile.ReadLine) If host Then 用 WMI ping可设超时比 shell.Run 弹窗干净 result False Dim pingRes For Each pingRes In wmi.ExecQuery _ (SELECT * FROM Win32_PingStatus WHERE Address host AND Timeout3000) If Not IsNull(pingRes.StatusCode) And pingRes.StatusCode 0 Then result True Next If result Then outFile.WriteLine [通] host okCount okCount 1 Else outFile.WriteLine [不通] ★ host failCount failCount 1 End If End If Loop inFile.Close outFile.WriteLine outFile.WriteLine 总计通 okCount 台不通 failCount 台 outFile.Close WScript.Echo 检测完成通 okCount 不通 failCount 报告已生成工程要点①Win32_PingStatus比shell.Run(ping ...)干净无弹窗、结果可编程判断②超时设 3000ms 平衡速度与准确性③只把不通标 ★——报告的价值在异常和巡检同一哲学。八、工程化把散脚本变成工具箱脚本一多就该像管理代码一样管理它们习惯做法收益统一模板每个脚本带头注释功能/用法/作者/日期半年后看得懂参数外置常量集中在脚本开头目录、天数、收件人改配置不改逻辑日志留痕关键动作写日志文件尤其删除/发送类出事可追溯错误处理On Error Resume Next只包关键 IO收尾恢复On Error Goto 0坏文件不拖垮全局测试开关发信脚本先.Display、清理脚本先只列不删上线前肉眼验证计划任务schtasks定时化 失败留退出码真正的无人值守退出码规范配合任务调度告警成功WScript.Quit 0参数错Quit 1执行异常Quit 2——调度器能按退出码报警脚本静默失败的事故就没了。九、避坑清单场景篇 8 条#坑后果解法1Excel/Outlook 进程驻留任务管理器一堆 EXCEL.EXE收尾QuitSet Nothing2删除脚本不看后缀误删重要文件白名单后缀 先记清单3On Error Resume Next全局包错误被静默吞只包关键段收尾归零4COM 自动化弹确认框脚本卡死等人工DisplayAlerts False5发信直接.Send内容错也发出去测试期.Display人工确认6路径写死带个人目录换机器就跑不了路径集中常量区相对路径优先7变量不声明拼写错出玄学 bug一律Option Explicit8脚本静默失败出事才知道没跑退出码 日志 失败告警十、总结与自测清单✅ 场景篇六脚本文件归类FSO、Excel 汇总COM、Outlook 日报、WMI 巡检、日志清理、批量探测——每个都能直接改配置就用✅ Excel/Outlook 自动化三纪律整块操作快、收尾 Quit 释放、测试期人工确认✅ 运维脚本两哲学白名单防误删、报告只突出异常✅ 工程化统一模板、参数外置、日志留痕、退出码规范——脚本也要可维护✅schtasks定时化把偶尔跑变成每天自动省 2 小时✅ 避坑 8 条贴墙尤其COM 进程驻留和删除白名单。下一篇预告《vb 的小脚本解决大问题进阶篇——正则、XML/JSON 处理与 Outlook 规则实战》敬请关注 学习教程传送门序号专栏学习内容当前状态01JAVA从入门到进阶的系统知识持续写作中……02Oracle数据库从用法到实战创作中……03vbs脚本手把手教你做脚本完善中……04IDEA牛逼哄哄的编程利器编写中……05面试吐血整理的面试技巧更新中…… 往期文章 精选往期好文更多请移步 我的博客主页 平安壹钱包面试官请你说一下Mybatis的实现原理 Java开发-热点-热门问题精华核心总结-推荐 第一章日常_JAVA_面试题集15含答案 第二章日常_JAVA_面试题集14含答案 往期文章大全…… 点赞 ⭐ 收藏 评论一键三连走起你们的支持是我持续创作的最大动力✨ 以上就是今天的全部内容关注我技术之路不迷路本人详解✍️ 作者王文峰参与 CSDN 2020 年度博客之星评选《Java王大师王天师》外号神秘小峯 / 山峯 中国国学、传统文化与代码爱好者的程序人生期待你的关注和支持 转载说明务必注明来源注明作者王文峰哦