【vbs脚本批量将ppt转换为word】||过滤掉表格和图片
2008年01月11日星期五 15:44
将下面代码复制下来，另存为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_='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.TypeText pptSelection.Slides(i).Shapes(j).TextFrame.TextRange.text
objSelection.TypeParagraph()
= "宋体"
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换行代码。

...。