ppt导出mp4 定时运行

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