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数据处理、开机自启动等），告诉我，我可以为您定制完整脚本！