VBS实战案例

vbs推荐学习资源：

VBS了解一下呗（有没有用学了才知道）_vbs 可以做什么-CSDN博客

注意事项：

出现如下错误时，需要在文件修改后缀vbs时-》另存为-》编码选择ANSI

 案例一：在文件所在目录下，将文件按后缀名分类

' 强制声明变量，要求在使用任何变量之前必须先声明它
Option Explicit


' 引用windows的COM组件对象模型
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")

' 获取当前目录
Dim currentFolder : Set currentFolder = objFSO.GetFolder(".")


' 分类并移动文件
Dim objFile, extension, targetFolderPath, targetFolderName, uniqueName
For Each objFile In currentFolder.Files
    extension = LCase(objFSO.GetExtensionName(objFile.Path))
' 如果存在扩展名
 
        targetFolderName = UCase(extension)&" "&"FILES"
        targetFolderPath = currentFolder.Path & "\" & targetFolderName
        
        ' 确保目标文件夹存在
        If Not objFSO.FolderExists(targetFolderPath) Then
            objFSO.CreateFolder targetFolderPath
        End If
        
        ' 生成唯一文件名并移动文件
        uniqueName = GetUniqueFilename(targetFolderPath, objFile.Name)
        objFile.Move targetFolderPath & "\" & uniqueName
   
Next

' 清理
Set objFSO = Nothing

Function GetUniqueFilename(targetFolderPath, originalFilename)
    Dim baseName, extension, newName, i
    baseName = objFSO.GetBaseName(originalFilename)
    extension = objFSO.GetExtensionName(originalFilename)
    newName = baseName &"."& extension
    i = 1
' 如何分类的文件重名，变成 名字+数字
    Do While objFSO.FileExists(targetFolderPath & "\" &newName)
        newName = baseName & " (" & i & ")" & "."&extension
        i = i + 1
    Loop
' 返回数据
    GetUniqueFilename = newName
End Function

案例二：批量修改当前目录下的指定后缀名

Option Explicit

' 壱明所有使用的变量
Dim strPathName, strOldExtension, strNewExtension, fso, folder, files, file, extension

' 创建FileSystemObject对象
Set fso = CreateObject("Scripting.FileSystemObject")



' 设置参数
strPathName = "."
strOldExtension = InputBox("输入要修改的后缀，如 txt")
strNewExtension = InputBox("输入修改后的后缀，如html")

' 检查指定目录是否存在
If Not fso.FolderExists(strPathName) Then
    WScript.Echo "目录不存在: " & strPathName
    WScript.Quit 1
End If

' 获取指定目录下的所有文件
Set folder = fso.GetFolder(strPathName)
Set files = folder.Files

' 遍历并处理文件
Sub ProcessFiles(files)
    Dim file
    For Each file In files
        ' 提取最后一个扩展名
        extension = Split(file.Name, ".")(UBound(Split(file.Name, ".")))
		'MsgBox extension
        
        ' 如果文件扩展名匹配
        If extension = strOldExtension Then
            ' 构建新文件名并尝试重命名
            On Error Resume Next ' 错误处理开关
            Dim newName : newName = Left(file.Name, Len(file.Name) - Len(strOldExtension)  -1) & "."&strNewExtension
            file.Name = newName
            If Err.Number <> 0 Then
                WScript.Echo "无法重命名文件: " & file.Path & " - " & Err.Description
                Err.Clear
            Else
                'WScript.Echo "文件已重命名: " & newName
            End If
            On Error GoTo 0 ' 关闭错误处理开关
        End If
    Next
End Sub

' 调用函数处理文件
ProcessFiles files

' 结束脚本
WScript.Echo "脚本执行完毕。"
WScript.Quit