Batch-Video-Export in Powerpoint

[shirter]

Hello,

I have to export video files from my powerpoint-presentations regularlyand I am using PP 2016. Since that tooks a lot of time, it would be great to have a batch-script which could export videos from several Powerpoint-Presentations overnight. Videos should be in Full-HD (1080p) and the single slides should use the recorded slide time.

Is it possible to do this in VBA? I have found some scripts for the export settings, but none for a batch-use.

Thanks for your reply,

regards

Jenson

[leemis]

did you find a solution for this by any chance? i am new to vb and powerpoint. i came across all the same stuff online you probably came across. i am trying to figure out the best way to export each slide as an individual video. i can export as a single video using a macro and i can export individual ppt files using a macro but can't seem to connect the two into a macro that will give me an individual video for each slide in a presentation.

if anyone can point me in a direction, i would appreciate it.

[John Wilson]

This should (not tested) export a batch of videos from ppt files in a folder on the desktop names "Files"

Sub BatchVid2()

   Dim rayFileList() As String
   Dim FolderPath As String
   Dim FileSpec
   Dim strTemp As String
   Dim x As Long
   Dim saveName As String
   Dim PresName As String
   Dim opres As Presentation


   
   FolderPath = Environ("USERPROFILE") & "\Desktop\Files\"      
   FileSpec = "*.ppt*"
   


   ' Fill the array with files that meet the spec above
   ReDim rayFileList(1 To 1) As String
   strTemp = Dir$(FolderPath & FileSpec)
   While strTemp <> ""
      rayFileList(UBound(rayFileList)) = FolderPath & strTemp
      ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1) As String
      strTemp = Dir
   Wend
   If UBound(rayFileList) > 1 Then
      ReDim Preserve rayFileList(1 To UBound(rayFileList) - 1)




      For x = 1 To UBound(rayFileList)
         Call Presentations.Open(rayFileList(x), False, False, True)
      Next x
   End If
   For x = 1 To UBound(rayFileList)
      PresName = Mid(rayFileList(x), InStrRev(rayFileList(x), "\") + 1)
      saveName = Left(PresName, InStrRev(PresName, ".") - 1)
      Presentations(PresName).CreateVideo FileName:=FolderPath & saveName & ".mp4", _
                                          UseTimingsAndNarrations:=True, _
                                          VertResolution:=1080, _
                                          FramesPerSecond:=25, _
                                          Quality:=100
   Next x


End Sub

There is no built in way to export a single slide to a video you would need to save a copy and delete unwanted slides.

[leemis]

This was more than helpful! Thank you!

It worked great and I was able to understand it (sort of) enough to add my other bits to it. Now to figure out how to zip up my results as a single zip.

[leemis]

one thing i tried to figure out was how to close all the windows when it was complete. i can close all the windows using a msgbox but have not figured out how to close it after each progress status was complete. Is there way to poll all the active open windows to know when it is complete? ppMediaTaskStatus.ppMediaTaskStatusDone doesn't seem to catch the event when it is done.

[leemis]

one thing i tried to figure out was how to close all the windows when it was complete.

I figured it out. Was looping through the wrong names. Thanks again for all the help!

[John Wilson]

Yep, I deliberately left the windows open because in code the window can close too early before the video is quite complete. It only takes a second to manually close them! Glad it worked though

[leemis]

Would you know if it is possible to take all the files (the videos, images, text files, etc) that i am exporting from this and zip it into a single file from within PPT? I need to take a folder full of files and zip them from within PPT. What I have found seems to be for xls and it uses the FileSystemObject which throws errors I don't really understand just yet other than it seems to not support it.

Seems like I might be able to create a batch file that can do this but I need to do this from PPT if possible.

[John Wilson]

This (based on Ron De Bruin's code) should zip everything in a folder. You would want to be sure the videos were NOT saved to the same folder as the original Powerpoint files.

Sub NewZip(sPath)'Create empty Zip File
Dim filenum As Integer
filenum = FreeFile
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #filenum
    Print #filenum, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #filenum
End Sub
Sub Zip_All_Files_in_Folder()
    Dim FileNameZip, FolderName
    Dim DefPath As String
    Dim oApp As Object


    DefPath = Environ("USERPROFILE") & "\Desktop\"
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If


    FolderName = Environ("USERPROFILE") & "\Desktop\test\"   '<< Change


    FileNameZip = DefPath & "FilesZip" & ".zip"


    'Create empty Zip File
    NewZip (FileNameZip)


    Set oApp = CreateObject("Shell.Application")
    'Copy the files to the compressed folder
    oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items


    MsgBox "You find the zipfile here: " & FileNameZip
End Sub