Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Dim objShell,objFolder,FolderPath,PW,wk,EAPP,FSO,FSOFolder,FSOFile
'获取Excel文件所在文件夹路径
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", OPTIONS,"")
If objFolder Is Nothing Then
Wscript.Quit
End If
FolderPath =objFolder.Self.Path
PW=Inputbox("请输入密码","批量添加密码")
if len(pw)=0 then Wscript.Quit
Set EAPP=CreateObject("PowerPoint.Application")
Set FSO=CreateObject("Scripting.FileSystemObject")
Set FSOFolder=FSO.GetFolder(FolderPath)
EAPP.Visible = True
For Each FSOFile in FSOFolder.Files
If instr(Fsofile.Name,".ppt") then
    Set wk=EAPP.Presentations.Open(FSOFile.Path,,,,Pw)
wk.PassWord=""
EAPP.selection.TypeBackSpace
wk.SaveAs FSOFile.Path
wk.close
End If
Next
EAPP.Quit
复制代码