1 系统日志自动归档器
Sub 日志归档()
' 按月份自动拆分日志表并加密
Dim logSheet As Worksheet, newSheet As Worksheet
Set logSheet = Sheets("操作日志")
Dim monthKey As String: monthKey = Format(Date, "yyyy-mm")
' 创建带密码的新工作表
Set newSheet = Worksheets.Add(After:=Sheets(Sheets.Count))
newSheet.Name = monthKey & "日志"
logSheet.Range("A1:G10000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=logSheet.Range("I1:I2"), CopyToRange:=newSheet.Range("A1")
' 添加工作表保护（密码123）
newSheet.Protect Password:="123", AllowFormattingCells:=True
MsgBox "日志已归档至【" & monthKey & "】表！", vbInformation
End Sub
2 硬盘空间监控仪
Sub 磁盘预警()
' 实时检测C盘剩余空间
Dim diskPath As String: diskPath = "C:\"
Dim freeSpaceGB As Double
freeSpaceGB = CreateObject("Scripting.FileSystemObject").GetDrive(diskPath).FreeSpace / 1024 ^ 3
' 桌面弹窗+单元格变色
If freeSpaceGB < 10 Then
Range("B2").Interior.Color = RGB(255, 0, 0)
Shell "mshta vbscript:msgbox(""C盘剩余空间仅剩"" & " & Round(freeSpaceGB,1) & " & ""GB！"",48,""磁盘警报"")(window.close)", vbHide
End If
End Sub
3 批量配置文件检查器
Sub 配置校验()
' 遍历指定目录检查INI文件完整性
Dim folderPath As String: folderPath = "D:\系统配置\"
Dim file As Object, fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each file In fso.GetFolder(folderPath).Files
If Right(file.Name, 3) = "ini" Then
' 检查关键字段是否存在
Open file.Path For Input As #1
fileContent = Input(LOF(1), 1)
Close #1
If InStr(fileContent, "[SystemConfig]") = 0 Then
Debug.Print file.Name & " 缺少系统配置段！"
End If
End If
Next
End Sub
4 服务状态看板生成器
Sub 服务监控()
' 抓取Windows服务状态生成可视化报表
Dim serviceDict As Object
Set serviceDict = CreateObject("WScript.Shell").Exec("sc queryex state= all").StdOut.ReadAll
' 解析服务状态到Excel
With Sheets("服务状态")
.Range("A2:D1000").ClearContents
.Range("A1") = "最后刷新：" & Now()
.Range("A2") = Split(Replace(serviceDict, Chr(13) & Chr(10), "|"), "|")
' 高亮停止的服务
.Range("D:D").AutoFilter Field:=4, Criteria1:="STOPPED"
.AutoFilter.Range.Interior.Color = RGB(255, 230, 230)
End With
End Sub
5 数据库自动备份器
Sub 智能备份()
' 每天17点自动备份SQL文件（需配合任务计划）
If Hour(Now()) = 17 Then
Dim backupCmd As String
backupCmd = "mysqldump -u root -p123456 db_production > " & ThisWorkbook.Path & "\backup\" & Format(Now(), "yymmdd") & ".sql"
Shell "cmd /k " & backupCmd, vbHide
' 写入操作日志
Sheets("日志").Cells(Rows.Count, 1).End(xlUp).Offset(1) = Now() & " 数据库备份完成"
End If
End Sub
高阶技巧：
- 按Alt+F8可直接运行宏
- 右键菜单绑定宏：开发工具→插入→按钮
- 设置定时任务：Windows任务计划程序调用宏