VBA - Automated PowerPoint won't open .pptx file that is being used by another User

Question

Completely untested, but let's try something like this (assuming you're getting an error on Presentations.Open. I added an error-handling block around this method call, and based on the documentation (here) it looks like the .Open method's Untitled argument is equivalent to creating a copy of the file.

If that doesn't work, let me know. I can revise to explicitly create and open a copy of the file and open that, instead.

UPDATE Since the Untitled property didn't work, let's try explicitly creating a copy of the file. I did not include any "cleanup" code to remove the copied versions.

Public Sub Update()

Dim PPTApp As Object
Dim PPT As Object
Dim MasterPPT As Presentation
Dim Total As Integer
Dim FSO As New Scripting.FileSystemObject
Dim Folder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim File As Scripting.File

Set MasterPPT = Presentations("Combined Staff Agenda Template.pptm")
Total = MasterPPT.Slides.Count

Set PPTApp = CreateObject("PowerPoint.Application")

' Sets the first ComboBox destination folder
Set Folder = FSO.GetFolder("O:\org\acle\Common\PE_SHARE\Technical Staff Meeting Agendas\Individual Slides\" & Order_UserForm.comboFirst.Value)

For Each SubFolder In Folder.SubFolders
    For Each File In SubFolder.Files

    ' Copies and pastes all slides for each file
    On Error GoTo FileInUseError
    Set PPT = PPTApp.Presentations.Open(File.Path, ReadOnly:=msoTrue, WithWindow:=msoFalse)
    On Error GoTo 0
    PPT.Slides.Range.Copy
    MasterPPT.Slides.Paste (Total)

    PPT.Close

    Total = MasterPPT.Slides.Count

    Next File
Next SubFolder

'## It's important to put this before your error-handling block:
Exit Sub

'## Error handling:
Err.Clear

'## First attempt, did not work as expected
'Set PPT = PPTApp.Presentations.Open(File.Path, ReadOnly:=msoTrue, Untitled:=msoTrue, WithWindow:=msoFalse)

 '## Second attempt. You will need to add some logic to remove these files or do it manually.
Dim copyPath as String
copyPath = Replace(File.Path, File.Name, "Copy of " & File.Name)
FSO.CopyFile File.Path, copyPath, True
Set PPT = PPTApp.Presentations.Open(copyPath)


Resume Next

End Sub

Update 2

Other things you could try (not likely to work, but you should try them anyways):

I notice that this code is executing from within PowerPoint, so one thing that doesn't make sense is the: Set PPTApp = CreateObject("PowerPoint.Application"). You're already running an instance of PPT, and only one instance of PPT runs (unlike Excel which can have multiple instances). So get rid of that line entirely.

'Set PPTApp = CreateObject("PowerPoint.Application")

Then also you can get rid of the variable PPTApp. I notice you use a combination of early- and late-binding for your PowerPoint Object Variables. That doesn't really make sense and while I wouldn't expect that to cause any errors, you never know.

'Dim PPTApp as Object 'PowerPoint.Application  '## This is unnecessary!!
Dim PPT as Presentation
Dim MasterPPT as Presentation

If all else fails, open the new file WithWindow=msoTrue and step through the code line by line using F8...

UPDATE 3

While I am not able to test a file that is locked/in-use by another user, I was able to test what happens if I have a file that is in use by myself. I use the following code and identify that the Files iteration will eventually encounter the lock/tmp version of the file, beginning with "~" tilde character. These are ordinarily hidden files, but FSO is picking them up in the iteration anyways.

Aside from that, I encounter similar errors if the file is not a valid PPT filetype (PPT, PPTX, PPTM, XML, etc.). I used the following code which prints a log of errors in the Immediate window (and informs you with MsgBox prompt) if there are errors.

Sub Test()
Dim MasterPPT As Presentation
Dim PPT As Presentation
Dim Total As Integer
Dim FSO As Object
Dim Folder As Object
Dim SubFolder As Object
Dim File As Object
Dim errMsg$
Dim copyPath$

Set MasterPPT = ActivePresentation '## Modify as needed.

Total = MasterPPT.Slides.Count

Set FSO = CreateObject("Scripting.FileSystemObject")

' Sets the first ComboBox destination folder // MODIFY AS NEEDED
Set Folder = FSO.GetFolder("C:\Users\david_zemens\Desktop\CHARTING STANDARDS")

For Each SubFolder In Folder.SubFolders
    For Each File In SubFolder.Files
        ' Copies and pastes all slides for each file
        On Error GoTo FileInUseError:
        ' Make sure it's a PPT file:
        If File.Type Like "Microsoft PowerPoint*" Then
10:
            Set PPT = Presentations.Open(File.Path, ReadOnly:=msoTrue, WithWindow:=msoFalse)
20:
           PPT.Slides.Range.Copy
30:
            MasterPPT.Slides.Paste (Total)

            PPT.Close

        End If
        On Error GoTo 0

    Total = MasterPPT.Slides.Count
NextFile:
    Next File
Next SubFolder

'## It's important to put this before your error-handling block:
Set FSO = Nothing
Set Folder = Nothing
Set SubFolder = Nothing
Set File = Nothing

Exit Sub

FileInUseError:
'## Error handling:
'## Display information about the error
errMsg = "Error No.: " & Err.Number & vbCrLf
errMsg = errMsg & "Description: " & Err.Description & vbCrLf
errMsg = errMsg & "At line #: " & Erl & vbCrLf
errMsg = errMsg & "File.Name: " & File.Name
Debug.Print errMsg & vbCrLf
MsgBox errMsg, vbInformation, "Error!"
Err.Clear
Resume NextFile

End Sub