vbs脚本批量将ppt转换为word

vbs脚本批量将ppt转换为word
2009年11月25日
　　 将下面代码复制下来，另存为convert.vbs。使用时请把所有要转换的ppt文件复制到目录c:\下。双击运行此脚本文件即可。
　　================================================================
　　strComputer = "."
　　on error resume next
　　Set objWMIService = GetObject("winmgmts:" _
　　& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
　　msgbox "此脚本可以批量将ppt文件中的文本转换为word文件。图片、表格等内容则自动跳过" & vbcrlf & "使用时请把所有要转换的ppt文件复制到目录c:\下。双击运行此文件即可。" & vbcrlf & "运行此脚本需要本机上安装了office"
　　Set objWord = CreateObject("Word.Application")
　　Set pptApp = CreateObject("PowerPoint.application")
　　Set FileList = objWMIService.ExecQuery _
　　("ASSOCIATORS OF {Win32_Directory.Name='c:'} Where " _
　　& "ResultClass = CIM_DataFile")
　　For Each objFile In FileList
　　If objFile.Extension = "ppt" Then
　　pptApp.visible = true
　　Set pptSelection = pptApp.Presentations.Open("c:\" & objFile.FileName & "." & objFile.Extension)
　　objWord.Visible = true
　　Set objDoc = objWord.Documents.Add()
　　Set objSelection = objWord.Selection
　　For i = 1 To pptSelection.Slides.Count
　　For j = 1 To pptSelection.Slides(i).Shapes.Count
　　if i =1 then
　　objSelection.Font.Name = "黑体"
　　objSelection.TypeText pptSelection.Slides(i).Shapes(j).TextFrame.TextRange.text
　　objSelection.TypeParagraph()
　　objSelection.Font.Name = "宋体"
　　end if
　　objSelection.TypeText pptSelection.Slides(i).Shapes(j).TextFrame.TextRange.text
　　objSelection.TypeText vbcrlf
　　Next
　　next
　　pptSelection.close
　　objDoc.SaveAs("c:\" & objFile.FileName & ".doc")
　　objDoc.close
　　msgbox "转换后的word已保存在c:\" & objFile.FileName & ".doc"
　　else
　　'msgbox "错误：c:\下没有发现ppt文件！"
　　End If
　　Next
　　pptApp.quit
　　=====================================================
　　=====================================================
　　比尔盖茨自小精通vb编程，后来开发的microsoft也都继续保有这个特色。vbs就是visual basic的脚本文件。像上次的 小狗定时提醒 就是这样子的。
　　======================================================
　　分析一下：
　　1>单引号“ ' ”后面表示注释
　　2>msgbox " " 表示消息框，引号里面是消息框显示内容。 "vbcrlf" 是vb换行代码。