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

hzliew · 发表于 2016-7-15 20:43:50

本帖最后由 pcl_test 于 2016-7-16 14:34 编辑

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

hzliew · 发表于 2016-7-15 22:12:10

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

gawk · 发表于 2016-7-15 22:27:43

能够介绍一下这样操作的目的是啥？

hzliew · 发表于 2016-7-15 22:31:42

本帖最后由 pcl_test 于 2016-7-16 00:51 编辑

回复 3# gawk

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

hzliew · 发表于 2016-7-16 09:52:45

我编写了一个脚本，但该脚本只能找到“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

WHY · 发表于 2016-7-16 10:46:01

拿去花

@if (0)==(0) echo off
set "srcDir=D:\test"
set "dstDir=E:\Temp"
md "%dstDir%" 2>nul
dir /b /a-d /s "%srcDir%\*.ppt" | cscript //nologo //e:jscript "%~f0" "%dstDir%"
pause & exit
@end
var dstDir = WSH.Arguments(0) + '\\';
var fso = new ActiveXObject('Scripting.FileSystemObject');
var objApp = new ActiveXObject('PowerPoint.Application');
objApp.Visible = true;
while(!WSH.StdIn.AtEndOfStream){
var strFile = WSH.StdIn.ReadLine();
var strName = fso.GetBaseName(strFile);
var strNewFile = dstDir + strName + '.ppt';
var i = 0;
while(fso.FileExists(strNewFile))strNewFile = dstDir + strName + '(' + (++i) + ').ppt';
var objPres = objApp.Presentations.Open(strFile, false, false, false);
objPres.SaveAs(strNewFile, 1, false);
objPres.Close();
}
objApp.Quit()

复制代码

hzliew · 发表于 2016-7-16 11:20:29

本帖最后由 hzliew 于 2016-7-16 11:21 编辑

回复 6# WHY

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

请按任意键继续...

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

ygqiang · 发表于 2016-7-16 11:43:33

回复 7# hzliew

6楼代码，win7 64系统测试成功。

hzliew · 发表于 2016-7-16 12:20:20

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

pcl_test · 发表于 2016-7-16 12:29:12

本帖最后由 pcl_test 于 2016-7-16 19:05 编辑

试试vbs会不会报错

Dim i
Set fso = CreateObject("Scripting.FileSystemObject")
Set pptApp = CreateObject("PowerPoint.application")
pptApp.visible = true
srcFolder = "D:\ppt" '源文件夹
dstFolder = "E:\另存" '目标文件夹
If Not fso.FolderExists(dstFolder) Then fso.CreateFolder(dstFolder)
Call getSubFiles(srcFolder, "ppt")
pptApp.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
SaveAsPPT File
End If
Next
For Each SubFolder In SubFolders
Call getSubFiles(SubFolder.Path, extension)
Next
Set Folder = nothing
Set SubFolders = nothing
End Function
Function SaveAsPPT(file)
i=i+1 '避免重名
Set ppt = pptApp.Presentations.Open(file.Path)
ppt.SaveAs(dstFolder&""&i&"_"&file.Name)
ppt.Close
End Function

复制代码

hzliew · 发表于 2016-7-16 12:36:33

本帖最后由 hzliew 于 2016-7-16 12:40 编辑

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

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

pcl_test · 发表于 2016-7-16 12:38:33

回复 11# hzliew

ppt的所在文件夹你改成你自己的没？

hzliew · 发表于 2016-7-16 12:41:22

回复 hzliew

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

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

hzliew · 发表于 2016-7-16 12:52:04

本帖最后由 hzliew 于 2016-7-16 12:55 编辑

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

pcl_test · 发表于 2016-7-16 14:11:15

回复 14# hzliew

xp你重新安装微软的Office软件

Set pptApp = CreateObject("PowerPoint.application")
file = "D:\ppt\2.ppt" 'ppt文件
pic = "D:\ppt\2.jpg" '需插入的图片
pptApp.visible = true
Set ppt = pptApp.Presentations.Open(file)
Set slide = ppt.Slides(1) '第一张幻灯片
Call slide.Shapes.AddPicture(pic, False, True, 100, 100, 400, 400) '插入图片

复制代码

		自动登录	找回密码
密码			注册

[新手上路]批处理新手入门导读	[视频教程]批处理基础视频教程	[视频教程]VBS基础视频教程	[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动	[批处理精品]CMD命令50条不能说的秘密	[在线下载]第三方命令行工具	[在线帮助]VBScript / JScript 在线参考

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

评分