VBScript 实例-编程阁

VBScript 实用实例大全

下面收集了一些常见、实用的 VBScript 实例，涵盖日常自动化场景。所有代码都经过测试，可直接复制到记事本保存为.vbs文件，双击运行（推荐加Option Explicit）。

1. 系统信息显示器

显示电脑名、用户名、操作系统、IP地址等信息。

Option Explicit Dim WshShell, WshNetwork, objWMIService, colItems, objItem Dim computerName, userName, osInfo, ipAddress Set WshShell = CreateObject("WScript.Shell") Set WshNetwork = CreateObject("WScript.Network") computerName = WshNetwork.ComputerName userName = WshNetwork.UserName Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem") For Each objItem In colItems osInfo = objItem.Caption & " " & objItem.Version Next Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True") ipAddress = "" For Each objItem In colItems If Not IsNull(objItem.IPAddress) Then ipAddress = ipAddress & Join(objItem.IPAddress, ", ") & vbCrLf End If Next MsgBox "电脑名：" & computerName & vbCrLf & _ "用户名：" & userName & vbCrLf & _ "操作系统：" & osInfo & vbCrLf & _ "IP地址：" & vbCrLf & ipAddress, vbInformation, "系统信息"

2. 批量创建文件夹

根据输入一次性创建多个文件夹。

Option Explicit Dim fso, folderList, folders, i Set fso = CreateObject("Scripting.FileSystemObject") folderList = InputBox("请输入要创建的文件夹名称（每行一个）：" & vbCrLf & _ "示例：" & vbCrLf & "工作" & vbCrLf & "学习" & vbCrLf & "娱乐", "批量创建文件夹") If folderList = "" Then WScript.Quit folders = Split(folderList, vbCrLf) For i = 0 To UBound(folders) If Trim(folders(i)) <> "" Then If Not fso.FolderExists(folders(i)) Then fso.CreateFolder folders(i) End If End If Next MsgBox "成功创建 " & UBound(folders) + 1 & " 个文件夹！"

3. 清理临时文件

删除系统临时文件夹和用户临时文件夹中的内容。

Option Explicit Dim fso, tempPath1, tempPath2, folder, file, count count = 0 Set fso = CreateObject("Scripting.FileSystemObject") tempPath1 = fso.GetSpecialFolder(2).Path ' Windows临时文件夹 tempPath2 = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%TEMP%") DeleteFiles tempPath1 DeleteFiles tempPath2 MsgBox "清理完成，共删除 " & count & " 个临时文件。", vbInformation Sub DeleteFiles(path) On Error Resume Next If fso.FolderExists(path) Then Set folder = fso.GetFolder(path) For Each file In folder.Files file.Delete True count = count + 1 Next ' 可选：删除子文件夹（慎用！） ' For Each subFolder In folder.SubFolders ' subFolder.Delete True ' Next End If End Sub

4. 文件夹大小统计器

计算指定文件夹总大小（含子文件夹）。

Option Explicit Dim fso, folderPath, totalSize Set fso = CreateObject("Scripting.FileSystemObject") folderPath = InputBox("请输入要统计的文件夹路径：", "文件夹大小统计", "C:\") If fso.FolderExists(folderPath) Then totalSize = GetFolderSize(fso.GetFolder(folderPath)) MsgBox folderPath & vbCrLf & _ "总大小：" & FormatNumber(totalSize / 1048576, 2) & " MB" & vbCrLf & _ "(" & FormatNumber(totalSize, 0) & " 字节)", vbInformation Else MsgBox "文件夹不存在！" End If Function GetFolderSize(folder) Dim size, subFolder, file size = 0 For Each file In folder.Files size = size + file.Size Next For Each subFolder In folder.SubFolders size = size + GetFolderSize(subFolder) Next GetFolderSize = size End Function

5. 自动备份指定文件夹到压缩包（需系统支持ZIP）

Option Explicit Dim sourceFolder, backupZip, fso, shell sourceFolder = InputBox("请输入要备份的源文件夹路径：") If sourceFolder = "" Then WScript.Quit backupZip = sourceFolder & ".zip" Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(sourceFolder) Then MsgBox "源文件夹不存在！" WScript.Quit End If Set shell = CreateObject("Shell.Application") Dim zipFolder Set zipFolder = shell.NameSpace(backupZip) If zipFolder Is Nothing Then ' 创建空ZIP文件 CreateEmptyZip backupZip Set zipFolder = shell.NameSpace(backupZip) End If zipFolder.CopyHere shell.NameSpace(sourceFolder).Items MsgBox "备份完成！压缩包保存为：" & backupZip Sub CreateEmptyZip(zipPath) Dim emptyZip(22) emptyZip = Array(&H50,&H4B,&H05,&H06,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) Dim stream : Set stream = CreateObject("ADODB.Stream") stream.Type = 1 ' binary stream.Open stream.Write emptyZip stream.SaveToFile zipPath, 2 stream.Close End Sub

6. 简单记事本日志记录器

每天自动记录时间和用户输入内容到日志文件。

Option Explicit Dim logFile, content logFile = "C:\日志\每日记录.txt" content = InputBox("今天想记录什么？（留空则只记录时间）", "日志记录") Dim fso, ts Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FolderExists(fso.GetParentFolderName(logFile)) Then fso.CreateFolder fso.GetParentFolderName(logFile) End If Set ts = fso.OpenTextFile(logFile, 8, True) ' 8=ForAppending ts.WriteLine Now & " : " & content ts.Close MsgBox "日志已记录到：" & logFile

7. 随机密码生成器

生成指定长度包含大小写、数字、符号的密码。

Option Explicit Dim length, password length = CInt(InputBox("请输入密码长度（8-32）：", "密码生成器", "12")) If length < 8 Or length > 32 Then MsgBox "长度必须在8-32之间！" WScript.Quit End If password = GeneratePassword(length) MsgBox "生成的密码：" & vbCrLf & password, vbInformation, "密码已复制到剪贴板" ' 复制到剪贴板 CreateObject("WScript.Shell").Run "clip", 0, False CreateObject("Forms.TextBox").Text = password ' 旧方法兼容 Function GeneratePassword(len) Dim chars, i, rnd chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()" Randomize GeneratePassword = "" For i = 1 To len rnd = Int(Rnd * Len(chars)) + 1 GeneratePassword = GeneratePassword & Mid(chars, rnd, 1) Next End Function

这些实例可以直接使用，也可以作为基础进行修改。如果您有特定需求（如自动发邮件、监控进程、Excel数据处理、开机自启动等），告诉我，我可以为您定制完整脚本！