ppttomp4.vbs
Option Explicit
Dim outPath,inPath,tempPath
'读取PPT文件夹
inPath = "d:\test\11"
'输出MP4文件夹,后面必须带\
outPath = "d:\test\out\"
'临时文件夹,存放未成功导出mp4的ppt文件,后面必须带\
tempPath= "d:\test\22\"
Function FilesTree(sPath,opath)
'遍历一个文件夹下的所有文件
Dim oFso,oFolder,oFiles,oFile
'创建个文件对象
Set oFso = CreateObject("Scripting.FileSystemObject")
'获取PPT文件夹
Set oFolder = oFso.GetFolder(sPath)
'获取文件夹下所有文件
Set oFiles = oFolder.Files
'循环取出文件夹下所有.pptx文件
For Each oFile In oFiles
If StrComp(LCase(oFso.GetExtensionName( oFile )),"pptx") = 0 then
'调用方法打开ppt,导出MP4,文件名相同
PPT2ANY oFile,opath&split(oFile.name,".")(0),"MP4"
'MsgBox oFile.Path
End If
'如果未导出mp4文件,把该文件移到临时文件夹
If not( oFso.FileExists( opath&split(oFile.name,".")(0)&".mp4") ) and not(oFso.FileExists(tempPath&oFile.name)) Then
oFso.MoveFile oFile,tempPath
else
'如果成功导出Mp4,删除ppt文件
oFile.Delete
End If
Next
Set oFolder = Nothing
Set oFso = Nothing
End Function
FilesTree inPath,outPath
Sub PPT2ANY( inFile, outFile, outFormat)
Dim objFSO, objPPT, objPresentation, pptFormat
Const ppSaveAsMP4 = 39
'创建一个文件系统对象
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' 创建一个ppt对象
Set objPPT = CreateObject( "PowerPoint.Application" )
With objPPT
' True: 可见ppt打开; False: 不可见
.Visible = True
' Check if the PowerPoint document exists
If not( objFSO.FileExists( inFile ) ) Then
WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
' Close PowerPoint
.Quit
Exit Sub
End If
' 打开PPT
.Presentations.Open inFile
' 激活文档
Set objPresentation = .ActivePresentation
pptFormat= ppSaveAsMP4
'导出mp4
objPresentation.SaveAs outFile, pptFormat
' 保存 MP4需要设置长点时间, 不要关闭过早,下面是30秒
If StrComp(Ucase( outFormat ),"MP4") = 0 then
wscript.sleep 1000*30
End If
objPresentation.Close
' Close PowerPoint
.Quit
End With
End Sub
run.vbs
Dim OK
set bag=getobject("winmgmts:\\.\root\cimv2")
set pipe=bag.ExecQuery("select * from win32_process where name='wscript.exe'")
if pipe.count > 1 then
Msgbox "do not touch again"
else
Set ws = CreateObject("Wscript.Shell")
Do
'0后台运行,true执行完再执行下面的语句
ws.run "cmd /c ppttomp4.vbs",0,true
'执行完上次,间隔60秒再执行
Wscript.Sleep(1000*60)
Loop
end if