ppt转成wmv的VBS脚本

PPT转成wmv的代码在网上找了很久都没合适的，很多都要花钱。同事在网上找到的一段代码，是把PPT转图片的。
后面修改了一下，可以把PPT转wmv格式。


Sub con()
'将文件夹下所有ppt转换成视频
Set fsObject = CreateObject("Scripting.FileSystemObject")
myPptDir = fsObject.GetAbsolutePathName("C:\Users\Administrator\Desktop\3.8\23045291_23044449") '放ppt的文件夹
If Not (fsObject.FolderExists(myPptDir)) Then
MsgBox myPptDir & "源文件夹不存在，程序终止。", vbCritical, "错误"
Wscript.Quit
End If
If InStrRev(myPptDir, "\") < Len(myPptDir) Then
myPptDir = myPptDir & "\"
End If
Set PptFilesDir = fsObject.Getfolder(myPptDir)
Set myPptFiles = PptFilesDir.Files
Set myObject = CreateObject("Powerpoint.Application")
For Each pptFile In myPptFiles
If LCase(Right(pptFile.Name, 3)) = "ppt" Then
JPGFileName = "C:\Users\Administrator\Desktop\3.8\23045291_23044449_wmv\" & Left(pptFile.Name, InStrRev(pptFile.Name, ".")) & "wmv"
'myPptDir表示要存的文件夹，默认是遍历的文件夹，可以随意改成任意的完整路径，得到的视频也会到相应的文件夹
Set Pres = myObject.Presentations.Open(pptFile.Path, False, False, False) 'Open(FileName,ReadOnly,Untitled,WithWindow)
Presentations(pptFile.Name).CreateVideo JPGFileName, DefaultSlideDuration:=1, VertResolution:=480
End If
Next
End Sub