Option Explicit
If WScript.Arguments.Count > 0 Then
	Dim oPPT,oPPTFile,[幻灯片],[计数器],fso,Arg
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set oPPT = CreateObject("PowerPoint.Application")
	Dim PPTFilePath,PPTFileBaseName
	For Each Arg In WScript.Arguments
		If fso.FileExists(Arg) And _
			(UCase(fso.GetExtensionName(Arg)) = "PPT" Or UCase(fso.GetExtensionName(Arg)) = "PPTX") Then
			
			With fso
				PPTFilePath = .GetParentFolderName(Arg)
				PPTFileBaseName = .GetBaseName(Arg)
			End With
			
			If Not fso.FolderExists(PPTFilePath&"\"&PPTFileBaseName) Then
				fso.GetFolder(PPTFilePath).SubFolders.Add PPTFileBaseName
			End If
			
			Set oPPTFile = oPPT.Presentations.Open(Arg)
			[计数器] = 0
			For Each [幻灯片] In oPPTFile.Slides
				[计数器] = [计数器] + 1
				[幻灯片].Export PPTFilePath&"\"&PPTFileBaseName&"\"&PPTFileBaseName&" ("&[计数器]&").JPG","JPG"
			Next
			oPPTFile.Close
			Set oPPTFile = Nothing
		End If
	Next
	oPPT.Quit
	Set oPPT = Nothing
Else
	MsgBox "请将文件拖到程序上～",,"【老刘制作】PPT转图片"
End If	fso.GetFolder(PPTFilePath).SubFolders.Add PPTFileBaseName
	End If
	
	Set oPPTFile = oPPT.Presentations.Open(WScript.Arguments(0))
	[计数器] = 0
	For Each [幻灯片] In oPPTFile.Slides
		[计数器] = [计数器] + 1
		[幻灯片].Export PPTFilePath&"\"&PPTFileBaseName&"\"&PPTFileBaseName&" ("&[计数器]&")."&"JPG","JPG"
	Next
	oPPTFile.Close
	Set oPPTFile = Nothing
	oPPT.Quit
	Set oPPT = Nothing
Else
	Msgbox "请将文件拖到程序上～",,"【老刘制作】PPT转图片"
End If
复制代码