How to generate PPT thumbnails automatically?

I have accumulated a lot of PPT templates in recent years. I want to make thumbnails like those PPT template websites . I have searched the Internet for a long time and tried many keywords:

.
  • PPT generates thumbnails in batches
  • PPT to Picture
  • batch generate PPT thumbnails
  • .

has not found the corresponding method, this can realize the function of PPT length map, but the generated picture is as big as PPT, which takes up too much space.

Jun.09,2022

the code found may have to be changed by yourself.

''  PowerPoint 
'' 
'' 
Dim wShell, pptApp, fso, folder, file, slide, outFile
Set wShell = WScript.CreateObject("WScript.Shell")
'' 
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(wShell.CurrentDirectory)
Set fso = Nothing
'MsgBox(folder.Path)
''  PowerPoint 
Set pptApp = WScript.CreateObject("PowerPoint.Application")
pptApp.Activate
'' 
For Each file in folder.Files
  ''  ppt PowerPoint  pps, pptx 
  If UCase(Mid(file.Name, InstrRev(file.Name, ".") + 1)) = "PPT" Then 
'    MsgBox(file.Name)
    '' 
    outFile = Trim(Left(file.Path, InStrRev(file.Path, ".") - 1)) & ".jpg"
'    MsgBox(outFile)
    pptApp.Presentations.Open file.Path
    '' 
    Set slide = pptApp.ActivePresentation.Slides(1)
    '' 
'     For Each slide in pptApp.ActivePresentation.Slides.Range(1)
        '' Export(String FileName, String FilterName, Long ScaleWidth, Long ScaleHeight)
        '' FilterName  gif, jpg, png, bmp, wmf, tif 
        slide.Export outFile, "jpg", 320, 240
'     Next
    pptApp.Presentations(1).Close
  End If
Next
''  PowerPoint 
pptApp.Quit
'' 
Set pptApp = Nothing
Set wShell = Nothing

original text: the page mentioned in https://blog.csdn.net/laobai_...
can't be opened. It's a pity

Menu