Excel系统维护高阶代码第二弹:5个工程师私藏工具

1 浏览器缓存自动清理器

Sub 清理缓存()

' 一键清理IE/Edge缓存（需管理员权限）

Shell "rundll32.exe InetCpl.cpl,ClearMyTracksByProcess 255", vbHide

' 清理Chrome缓存（路径自动识别）

Dim chromePath As String

chromePath = Environ("LOCALAPPDATA") & "\Google\Chrome\User Data\Default\Cache\"

If Dir(chromePath, vbDirectory) <> "" Then

Shell "cmd /c del /q " & chromePath & "*.*", vbHide

End If

MsgBox "浏览器缓存已深度清理！", vbInformation

End Sub

2 系统启动项管理看板

Sub 分析启动项()

' 抓取注册表启动项生成报表

Dim regObj As Object, startupItems As Object

Set regObj = GetObject("winmgmts:\\.\root\default:StdRegProv")

regObj.EnumValues &H80000002, "Software\Microsoft\Windows\CurrentVersion\Run", startupItems

' 输出到Excel并分析可疑项

With Sheets.Add(After:=Sheets(Sheets.Count))

.Range("A1") = "【系统启动项监控表】"

.Range("A2:B2") = Array("启动名称", "执行路径")

For i = 0 To startupItems.Count - 1

.Cells(i + 3, 1) = startupItems(i)

regObj.GetStringValue &H80000002, "Software\Microsoft\Windows\CurrentVersion\Run", startupItems(i), .Cells(i + 3, 2)

' 标记非常见路径

If InStr(.Cells(i + 3, 2), "AppData") > 0 Then .Cells(i + 3, 2).Font.Color = RGB(255, 0, 0)

Next

End With

End Sub

3 磁盘健康预警系统

Sub 检测磁盘()

' 通过SMART数据检测磁盘健康度

Dim diskStatus As String

diskStatus = CreateObject("WScript.Shell").Exec("wmic diskdrive get status").StdOut.ReadAll

With Sheets("磁盘监控")

.Range("A2").Value = "最后检测：" & Now()

.Range("B4").Value = Split(diskStatus, vbCrLf)(1)

' 异常状态预警

If InStr(diskStatus, "OK") = 0 Then

.Shapes.AddShape(msoShapeOval, 400, 100, 50, 50).Fill.ForeColor.RGB = RGB(255, 0, 0)

.Range("B4").AddComment "建议立即备份数据并更换硬盘！"

End If

End With

End Sub

4 USB设备管控工具

Sub USB管控()

' 通过注册表禁用USB存储设备（需重启生效）

Dim ws As Object

Set ws = CreateObject("WScript.Shell")

' 写入注册表键值

ws.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\USBSTOR\Start", 4, "REG_DWORD"

' 生成操作日志

Dim logEntry As String

logEntry = Now() & " USB存储设备已禁用（代码4）"

ThisWorkbook.Sheets("安全日志").Range("A" & Rows.Count).End(xlUp).Offset(1) = logEntry

MsgBox "USB存储策略已更新，重启后生效！", vbExclamation

End Sub

5 计划任务备份专家

Sub 备份任务计划()

' 导出所有计划任务配置为XML

Dim taskList As String

taskList = CreateObject("WScript.Shell").Exec("schtasks /query /fo LIST").StdOut.ReadAll

' 创建备份目录

MkDir ThisWorkbook.Path & "\TaskBackup"

' 遍历任务并导出

For Each task In Split(taskList, vbCrLf)

If Left(task, 8) = "任务名:" Then

taskName = Mid(task, InStr(task, ":") + 2)

Shell "schtasks /export /tn """ & taskName & """ /xml >> " & ThisWorkbook.Path & "\TaskBackup\" & taskName & ".xml", vbHide

End If

Next

MsgBox "共备份" & UBound(Split(taskList, "任务名:")) & "个计划任务！", vbInformation

End Sub

高级调试技巧：

1. 按Ctrl+G进入立即窗口，可用?变量名实时查看数据
2. 在代码中加入Stop语句设置断点
3. 使用Debug.Print输出运行日志