ppt、pptx的文件自动批量生成缩略图

需求：
将当前日期对应的“年-月”格式的文件夹下所有ppt及pptx文件的第一张幻灯片批量生成图片；
每天定时执行一次，生成上次未生成的文件

方案：

1. 建立脚本文件ppttojpg.vbs，实现ppt、pptx文件生成jpg格式的缩略图（需安装powerpoint）

ppttojpg.vbs：

'' 导出当前时间对应的日期文件夹下所有 PowerPoint 演示文稿的第一张幻灯片
'' 并以图形文件格式保存在当前文件夹的日期格式子文件夹下
'' 变量声明和初始化
'' gq 2011年1月5日11:50:55

on error resume Next         ''出错跳到下一个循环(可预防当某文件损坏无法打开导致的执行停止的问题出现)

Dim wShell, pptApp, fso, folder, file, slide, outFile
Set wShell = WScript.CreateObject("WScript.Shell")
'' 获取当前文件夹
Set fso = CreateObject("Scripting.FileSystemObject")
'' 下面六行生成yyyy-mm格式
Dim sDate,sYear,sMonth,ympath
sDate =Now()
sYear = Year(date)
sMonth = Month(date)
if len(sMonth)=1 then sMonth="0"&sMonth End if
ympath = sYear & "-" & sMonth

'MsgBox(ympath)
'' 指向下一级的日期格式目录
Set folder = fso.GetFolder(wShell.CurrentDirectory+"/"+ympath)

'MsgBox(folder)
'' 打开 PowerPoint 应用程序
Set pptApp = WScript.CreateObject("PowerPoint.Application")
pptApp.Activate
'' 遍历当前文件夹下所有文件
For Each file in folder.Files
  '' 如果文件扩展名为 ppt（根据实际需要和 PowerPoint 程序版本，还可以是 pps, pptx 等）
   '' 设置输出文件名，此处使用原演示文稿名称
   ''大图
    outFile = Trim(Left(file.Path, InStrRev(file.Path, ".") - 1)) & ".jpg"
 ''缩略图
 outFileb_dump  = Trim(Left(file.Path, InStrRev(file.Path, ".") - 1)) & "_dump.jpg"
  'MsgBox(outFile)
  ''If UCase(Mid(file.Name, InstrRev(file.Name, ".") + 1)) = "PPT" Then

  '下一行增加pptx格式的文件(office 2007可用)和判断jpg文件不存在，再执行转换
  If ((UCase(Mid(file.Name, InstrRev(file.Name, ".") + 1)) = "PPT" Or UCase(Mid(file.Name, InstrRev(file.Name, ".") + 1)) = "PPTX" ) And Not fso.fileexists(outFile)) Then
    'MsgBox(file.Name)
    pptApp.Presentations.Open file.Path
    '' 此处只需要第一张幻灯片
    Set slide = pptApp.ActivePresentation.Slides(1)
    '' 如果需要导出多张幻灯片，使用如下循环
'     For Each slide in pptApp.ActivePresentation.Slides.Range(1)
        '' Export(String FileName, String FilterName, Long ScaleWidth, Long ScaleHeight)
        '' FilterName 可以为 gif, jpg, png, bmp, wmf, tif 等。
        slide.Export outFile, "jpg", 480, 360
        slide.Export outFileb_dump, "jpg", 160, 120
'     Next
    pptApp.Presentations(1).Close
  End If
Next
Set fso = Nothing
'' 退出 PowerPoint 应用程序
pptApp.Quit
'' 清理对象
Set pptApp = Nothing
Set wShell = Nothing

1. 将上一步的vbs文件 加入到系统计划任务