WHY

拿去花

@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()
复制代码

WHY

回复 16# hzliew

@if (0)==(0) echo off
set "srcDir=D:\Test"
set "dstDir=E:\Temp"
xcopy /s /t "%srcDir%\*" "%dstDir%\"
dir /b /a-d /s "%srcDir%\*.ppt" | cscript //nologo //e:jscript "%~f0" "%srcDir%" "%dstDir%"
(for /f "delims=" %%i in ('dir /b /ad /s "%dstDir%\*" ^| sort /r') do rd "%%i") 2>nul
pause & exit
@end

var arr = WSH.Arguments;
var reg = new RegExp('^' + arr(0).replace(/[\^$+\-\\()[\]{}.]/g, '\\$&'), 'i');
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 strNewFile = strFile.replace(reg, arr(1));
    var objPres = objApp.Presentations.Open(strFile, false, false, false);
    objPres.SaveAs(strNewFile);
    objPres.Close();
}

objApp.Quit()
复制代码

正则表达式漏掉特殊字符“.” 补上

WHY

回复 17# hzliew


    把 33 行改成 File.Path

WHY

我觉得 pcl_test 版主17楼的vbs方案考虑不够周全

假设doc文件全部位于 E:\Temp 目录的下一级目录，创建文件夹会失败
另外，假设 srcFolder 变量值为D:\test，而实际目录名为D:\TEST
由于vbs的replace方法区分大小写，字符串不会被替换

WHY

Dim srcDir, dstDir, fso, objApp

srcDir = "D:\Test"
dstDir = "E:\Temp"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objApp = CreateObject("PowerPoint.Application")
objApp.Visible = True

Call EnumFiles(srcDir)

objApp.Quit
Set objApp = Nothing : Set fso = Nothing

Function EnumFiles(strPath)
    Dim objFile, strExt, arr, strNewFile, objFolder
    For Each objFile In fso.GetFolder(strPath).Files
        strExt = fso.GetExtensionName(objFile.Path)
        If LCase(Left(strExt, 3)) = "ppt" Then
            strNewFile = Replace(objFile.Path, srcDir, dstDir, 1, 1, 1)
            arr = Split(strNewFile, "\")
            If UBound(arr) > 1 Then Call CreateSubFolder(arr)
            Call SaveFile(objFile.Path, strNewFile)
        End If
    Next
      
    For Each objFolder In fso.GetFolder(strPath).SubFolders
        Call EnumFiles(objFolder.Path)
    Next
End Function

Function CreateSubFolder(ByVal arr)
    Dim i, strSubFolder
    strSubFolder = arr(0)
    For i = 1 To UBound(arr) - 1
        strSubFolder = strSubFolder & "\" & arr(i)
        If Not fso.FolderExists(strSubFolder) Then fso.CreateFolder(strSubFolder)
    Next
End Function

Function SaveFile(strFile, ByVal strNewFile)
    Dim objPres
    Set objPres = objApp.Presentations.Open(strFile, false, false, false)
    objPres.SaveAs(strNewFile)
    objPres.Close
    Set objPres = Nothing
End Function
复制代码