批量转化ppt和pptx文件为txt的vbs可拖PPT文件到该vbs上或直接同目录运行vbs批量转化
本帖最后由 sairen139 于 2020-5-21 19:01 编辑批量转化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
感谢分享，学习 很厉害，也很给力。学习了，谢谢！ 谢谢分享 感谢分享，学习
页:
[1]