[文件操作] 批处理如何打开指定目录下（包含子目录）的ppt文件并另存到其他目录

hzliew

请教：搜索某个目录（比如D:\课件，包含子目录）下的所有ppt文件，逐一打开然并以原文件名另存到另一个目录下（比如E:\temp）后关闭，直到所有的文件都执行完毕。请问这个批处理怎么写？先谢谢了。

hzliew

或者谁能告诉我，如何用批处理命令实现对ppt文件的另存为也可以，不是复制，是打开后另存为哦。谢谢。

hzliew

回复 3# gawk


    回楼上的：原因比较特殊，极少数人会碰到这个问题。由于我的课件被内部加入了水印，直接拷贝出去在别的电脑会无法读取。但如果先打开后再另存为到一个特殊目录，即可脱掉水印，就可以拷贝了。课件比较多，所以希望批处理。方法不限，能用VBS语法实现也行。

hzliew

我编写了一个脚本，但该脚本只能找到“C：\”根目录下的ppt文件，如何找到某目录（包含子目录）下的所有ppt文件并进行保存?我的脚本如下：
strComputer = "."
on error resume next
Set objWMIService = GetObject("winmgmts:" _
     & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
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)
  pptSelection.SaveAs("c:\" & objFile.FileName & "2.ppt")
  pptSelection.close
     End If
Next
pptApp.quit

hzliew

回复 6# WHY


    谢谢，不过失败了。我将你的代码保存为convert.bat，放在D:\test 下运行（该目录放了一个样本ppt文件），得到出错提示：
D:\test\convert.bat<11,1>Microsoft JScript 运行时错误： Automation 服务器不能创建对象

请按任意键继续...

我的系统为XP系统，是否跟系统有关？

hzliew

问题出在var objApp = new ActiveXObject('PowerPoint.Application');这一行上。难道XP系统对调用ActiveXObject很敏感？

hzliew

试试vbs会不会报错
pcl_test 发表于 2016-7-16 12:29

    WIN7下测试成功，下面试试XP系统

hzliew

回复  hzliew

ppt的所在文件夹你改成你自己的没？
pcl_test 发表于 2016-7-16 12:38

    不好意思，刚忘了改。改了WIN7下是成功的，现在看看XP。

hzliew

怎么插入截图啊，XP系统下还是那个问题，第3行：ActiveX部件不能创建对象：“PowerPoint application”，看来这是XP系统的顽疾。。。

hzliew

回复  hzliew

xp你重新安装微软的Office软件
pcl_test 发表于 2016-7-16 14:11

    真没想到是office自身的问题，重装office就好了，谢谢您的提醒。再次感谢您以及6楼的兄弟，以非常牛X的而且不同的思路和视角解决了此问题。

追加一个问题：能否在保存这些文件时保持原来文件的目录结构？比如，源目录中D:\test\chap1\1.ppt, D:\test\chap2\1.ppt, D:\test\chap3\1.ppt, 转换到E:\Temp后，分别为E:\Temp\chap1\1.ppt，E:\Temp\chap2\1.ppt，E:\Temp\chap3\1.ppt，也就是让那些上千个ppt文件分别保存在各自不同的章节目录里，只是根目录变了，其他不变？

hzliew

回复 10# pcl_test

我仿照您的代码来转换doc文档，为何提示33行类型不匹配：

Set fso = CreateObject("Scripting.FileSystemObject")
Set wordApp = CreateObject("Word.application")
Set ws = CreateObject("WScript.Shell")
wordApp.visible = true
srcFolder = "D:\test"  '源文件夹
dstFolder = "E:\Temp"  '目标文件夹
If Not fso.FolderExists(dstFolder) Then fso.CreateFolder(dstFolder)
Call getSubFiles(srcFolder, "doc")
wordApp.Quit
msgbox "Done"

'遍历文件夹查找指定扩展名文件
Function getSubFiles(path, extension)
    Set Folder = fso.GetFolder(path)
    Set SubFolders = Folder.SubFolders
      
    Set Files = Folder.Files
    For Each File In Files
        If LCase(Right(File.Name, Len(extension))) = LCase(extension) Then
            SaveAsDOC Folder, file
        End If
    Next
      
    For Each SubFolder In SubFolders
        Call getSubFiles(SubFolder.Path, extension)
    Next
    
    Set Folder = nothing
    Set SubFolders = nothing
End Function

Function SaveAsDOC(folder, file)  '增加保留源文件目录结构
    newpath = replace(LCase(Left(folder.Path, Len(srcFolder)))&Mid(folder.Path, Len(srcFolder)+1), LCase(srcFolder), dstFolder)
    If Not fso.FolderExists(newpath) Then ws.run "cmd /c md """&newpath&"", 0
    Set doc = wordApp.Documents.Open(file.Path)
    doc.SaveAs(newpath&"\"&file.Name)
    doc.Close
End Function
复制代码

hzliew

回复 19# WHY


    还是您火眼金睛啊。。。

hzliew

回复  hzliew
WHY 发表于 2016-7-16 18:00

    哇塞，兄弟真牛B，代码简洁，堪称完美！佩服佩服！

hzliew

回复  hzliew

17楼已改
pcl_test 发表于 2016-7-16 19:10

    经测试运行，您的代码正确无误。至此，问题圆满解决，谢谢！