pcl_test

试试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
复制代码

pcl_test

回复 11# hzliew

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

pcl_test

回复 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)  '插入图片
复制代码

pcl_test

回复 17# hzliew

17楼已改

pcl_test

回复 24# WHY

已改