批量转化ppt和pptx文件为txt的vbs可拖PPT文件到该vbs上或直接同目录运行vbs批量转化

sairen139

批量转化ppt和pptx文件为txt的vbs，可拖PPT文件到该vbs上或文件夹内直接运行vbs批量转化该文件夹里的所有PPT文件新生成同名的TXT文件文件！
PPT转TXT文件用vbs写的小工具PPT2TXT.vbs，将ppt文件转换为txt文本文件，便于后续的文本处理。

使用方法：将需要转换的文件通过鼠标拖拽到该vbs上，或将该vbs粘贴到文件夹然后双击运行，可以把文件夹内的所有ppt文件转换为txt文本文件 注：需安装有office。仅转换文本，不支持图表等其他非文字对象:
' PPT2TXT.vbs
' Usage:
' (1) Drag one ppt file to this file
' (2) Copy this file to one folder and run. All ppt files in the folder will be converted to txt files

On Error Resume Next
set FSO = CreateObject("Scripting.FileSystemObject")
count = 0
ArgNum = WScript.Arguments.Count
if ArgNum = 0 then
  set files = FSO.GetFolder(".").Files
else
  set files = WScript.Arguments
end if

for each file in files
  ExName = LCase(FSO.GetExtensionName(file))
  if Left(ExName,3) = "ppt" then
    set objApp = CreateObject("PowerPoint.Application")
    objApp.Visible = true
    set objPresentation = objApp.Presentations.Open(file)
    FileName = Left(file,instrrev(file,".")) & "txt"
    set TxtFile = FSO.CreateTextFile(FileName,true)
    for i = 1 to objPresentation.Slides.Count
      for j = 1 to objPresentation.Slides(i).Shapes.Count
        TxtFile.WriteLine(objPresentation.Slides(i).Shapes(j).TextFrame.TextRange.Text)
        if Err.Number <> 0 then
          Err.Clear
        end if
      next      
    next
    TxtFile.Close
    objPresentation.Close
    objApp.Quit
    set TxtFile = nothing
    set objPresentation = nothing
    set objApp = nothing     
    count = count + 1
  end if
next

set files = nothing
set FSO = nothing
if Err.Number <> 0 then
  msgbox "Failed to convert some files in all " & count & " files!" & VbCrLf & "Possible reason:" & VbCrLf & "Some files are corrupt"
else
  WScript.Echo count & " file(s) converted successfully"
end if
Err.Clear
Wscript.Quit

MC阿虎

感谢分享，学习

dszsdyx

很厉害，也很给力。学习了，谢谢！

at_ape

谢谢分享

hexj68

感谢分享，学习