问题
I'm trying to write a script that will copy mp4 files to specific folders based on their frame height or frame rate. This is the code I have now that works but this just copies all MP4 files in a folder and subfolders to a destination folder.
How do I take it a step further and separate the files based on the frame height (720 for 720p files and 1080 for 1080i files)?
Option Explicit
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objSTR, objMP4dest, objXCHANGEdest, objMP4ext, objXCHANGEext, obj720dest, obj1080dest
Dim objFILE, objFILE2, Folder, SubFolder
objSTR = "C:\Users\RMalone.SEC\Videos\MP4 Transfer Test\" 'Folder to search through
objMP4dest = "C:\Users\RMalone.SEC\Videos\MP4 Destination\" 'Folder I want mp4 files to copy to
obj720dest = "C:\Users\RMalone.SEC\Videos\MP4 Destination\720p 60fps\"
'Folder for 720p 60fps files
obj1080dest = "C:\Users\RMalone.SEC\Videos\MP4 Destination\1080 30fps"
'Folder for 1080i 30fps files
objXCHANGEdest = "C:\Users\RMalone.SEC\Videos\Finished\" 'Folder I want xchange files to copy to
objMP4ext = "mp4"
objXCHANGEext = "xchange"
For Each objFILE in objFSO.GetFolder(objSTR).Files
If objFSO.GetExtensionName(objFILE.Path) = objMP4ext Then
objFILE.Copy objMP4dest
End If
Next
For Each objFILE in objFSO.GetFolder(objSTR).Files
If objFSO.GetExtensionName(objFILE.Path) = objXCHANGEext Then
objFILE.Copy objXCHANGEdest
End If
Next
Call srchSUBFOLD(objFSO.GetFolder(objSTR))
Function srchSUBFOLD(Folder)
For Each SubFolder in Folder.SubFolders
For Each objFILE in objFSO.GetFolder(SubFolder.Path).Files
If objFSO.GetExtensionName(objFILE.Path) = objMP4ext Then
objFILE.Copy objMP4dest
End If
Next
Call srchSUBFOLD(SubFolder)
Next
End Function
Function srchSUBFOLD(Folder)
For Each SubFolder in Folder.SubFolders
For Each objFILE in objFSO.GetFolder(SubFolder.Path).Files
If objFSO.GetExtensionName(objFILE.Path) = objXCHANGEext Then
objFILE.Copy objXCHANGEdest
End If
Next
Call srchSUBFOLD(SubFolder)
Next
End Function
回答1:
The frame height is stored in the files' extended properties. You can access the value like this:
dirname = "C:\your\video\folder"
Set fso = CreateObject("Scripting.FileSystemObject")
Set app = CreateObject("Shell.Application")
Set ns = app.Namespace(dirname)
For Each f In fso.GetFolder(dirname)
If LCase(fso.GetExtensionName(f)) = "mp4" Then
fheight = ns.GetDetailsOf(ns.ParseName(f.Name), 283)
Select Case fheight
Case "720" : 'copy to one location
Case "1080" : 'copy to other location
Case Else : WScript.Echo "Unknown frame height " & fheight & _
" for file " & f.Name & "."
End Select
End If
Next
You can identify the names and index numbers of extended properties like this:
dirname = "C:\your\video\folder"
Set app = CreateObject("Shell.Application")
Set ns = app.Namespace(dirname)
For i=0 To 300
WScript.Echo i & vbTab & ns.GetDetailsOf(ns.Items, i)
Next
Note: Run the script with cscript.exe
, so you don't get 300 popups!
来源:https://stackoverflow.com/questions/51460551/vbscript-to-copy-720p-60fps-mp4-files