自动统计每个子文件夹里的图片数量、视频数量、媒体总大小，然后把文件夹改成：

原文件夹名 [43P3V-310MB]

如果原来已经有类似 [54P8V-0.99GB]，会自动更新，不会重复追加。

保存为：批量统计图片视频并重命名.vbs ,把脚本移到需要修改的文件夹内运行！

Option Explicit

Dim fso, rootPath, rootFolder
Dim imageExts, videoExts
Dim folder, folders
Dim renamedCount, skipCount
Dim Recursive

Recursive = True

Set fso = CreateObject("Scripting.FileSystemObject")

rootPath = fso.GetParentFolderName(WScript.ScriptFullName)
Set rootFolder = fso.GetFolder(rootPath)

Set imageExts = CreateObject("Scripting.Dictionary")
Set videoExts = CreateObject("Scripting.Dictionary")
Set folders = CreateObject("Scripting.Dictionary")

AddExt imageExts, "jpg,jpeg,png,gif,webp,bmp,tif,tiff,heic,heif,avif"
AddExt videoExts, "mp4,mkv,avi,mov,wmv,flv,webm,m4v,ts,mts,m2ts,rm,rmvb,3gp"

For Each folder In rootFolder.SubFolders
    folders.Add folder.Path, folder.Name
Next

renamedCount = 0
skipCount = 0

Dim folderPath
For Each folderPath In folders.Keys
    ProcessFolder folderPath
Next

MsgBox "Done!" & vbCrLf & _
       "Renamed: " & renamedCount & vbCrLf & _
       "Skipped: " & skipCount, vbInformation, "Finished"


Sub AddExt(dict, extList)
    Dim arr, i, ext
    arr = Split(extList, ",")

    For i = 0 To UBound(arr)
        ext = LCase(Trim(arr(i)))
        If Not dict.Exists(ext) Then
            dict.Add ext, True
        End If
    Next
End Sub


Sub ProcessFolder(folderPath)
    On Error Resume Next

    Dim targetFolder
    Set targetFolder = fso.GetFolder(folderPath)

    If Err.Number <> 0 Then
        Err.Clear
        skipCount = skipCount + 1
        Exit Sub
    End If

    Dim imgCount, vidCount, totalBytes
    imgCount = 0
    vidCount = 0
    totalBytes = 0

    CountMedia targetFolder, imgCount, vidCount, totalBytes

    Dim sizeText, suffix, baseName, newName, newPath
    sizeText = FormatSize(totalBytes)

    If vidCount > 0 Then
        suffix = "[" & imgCount & "P" & vidCount & "V-" & sizeText & "]"
    Else
        suffix = "[" & imgCount & "P-" & sizeText & "]"
    End If

    baseName = RemoveOldSuffix(targetFolder.Name)
    newName = baseName & " " & suffix
    newPath = fso.BuildPath(targetFolder.ParentFolder.Path, newName)

    If targetFolder.Name = newName Then
        skipCount = skipCount + 1
        Exit Sub
    End If

    If fso.FolderExists(newPath) Then
        skipCount = skipCount + 1
        Exit Sub
    End If

    Err.Clear
    targetFolder.Name = newName

    If Err.Number <> 0 Then
        Err.Clear
        skipCount = skipCount + 1
    Else
        renamedCount = renamedCount + 1
    End If

    On Error GoTo 0
End Sub


Sub CountMedia(folderObj, ByRef imgCount, ByRef vidCount, ByRef totalBytes)
    On Error Resume Next

    Dim file, subFolder, ext

    For Each file In folderObj.Files
        ext = LCase(fso.GetExtensionName(file.Name))

        If imageExts.Exists(ext) Then
            imgCount = imgCount + 1
            totalBytes = totalBytes + CDbl(file.Size)
        ElseIf videoExts.Exists(ext) Then
            vidCount = vidCount + 1
            totalBytes = totalBytes + CDbl(file.Size)
        End If
    Next

    If Recursive = True Then
        For Each subFolder In folderObj.SubFolders
            CountMedia subFolder, imgCount, vidCount, totalBytes
        Next
    End If

    On Error GoTo 0
End Sub


Function RemoveOldSuffix(nameText)
    Dim reg
    Set reg = CreateObject("VBScript.RegExp")

    reg.Pattern = "\s*\[\d+P(\d+V)?-[^\]]+\]$"
    reg.IgnoreCase = True
    reg.Global = False

    RemoveOldSuffix = reg.Replace(nameText, "")
End Function


Function FormatSize(bytes)
    Dim mb, gb, txt

    mb = bytes / 1024 / 1024

    If mb >= 1024 Then
        gb = bytes / 1024 / 1024 / 1024
        txt = CStr(Round(gb, 2))
        txt = Replace(txt, ",", ".")

        If InStr(txt, ".") > 0 Then
            Do While Right(txt, 1) = "0"
                txt = Left(txt, Len(txt) - 1)
            Loop

            If Right(txt, 1) = "." Then
                txt = Left(txt, Len(txt) - 1)
            End If
        End If

        FormatSize = txt & "GB"
    Else
        FormatSize = CStr(CLng(mb + 0.5)) & "MB"
    End If
End Function