完全未经测试，但让我们尝试这样的事情（假设您在 Presentations.Open 上遇到错误。我在此方法调用周围添加了一个错误处理块，并根据文档 (here) 它看起来像.Open 方法的 Untitled 参数相当于创建文件的副本。
如果这不起作用，请告诉我。我可以修改为显式创建并打开文件的副本并打开它。
更新 由于Untitled 属性不起作用，让我们尝试显式创建文件的副本。我没有包含任何“清理”代码来删除复制的版本。
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
更新 2
您可以尝试的其他方法（不太可能有效，但无论如何您都应该尝试）：
我注意到这段代码是在 PowerPoint 中执行的，所以没有意义的一件事是：Set PPTApp = CreateObject("PowerPoint.Application")。您已经在运行一个 PPT 实例，并且只运行一个 PPT 实例（不像 Excel 可以有多个实例）。所以完全摆脱那条线。
'Set PPTApp = CreateObject("PowerPoint.Application")
然后你也可以去掉变量PPTApp。我注意到您对 PowerPoint 对象变量使用了早期绑定和后期绑定的组合。这没有任何意义，虽然我不认为这会导致任何错误，但你永远不会知道。
'Dim PPTApp as Object 'PowerPoint.Application '## This is unnecessary!!
Dim PPT as Presentation
Dim MasterPPT as Presentation
如果一切都失败了，请打开新文件 WithWindow=msoTrue 并使用 F8 逐行执行代码...
更新 3
虽然我无法测试 另一个 用户锁定/正在使用的文件，但我能够测试如果我有一个 正在使用的文件会发生什么我自己。我使用以下代码并确定Files 迭代最终会遇到文件的lock/tmp 版本，以“~”波浪字符开头。这些通常是隐藏文件，但无论如何 FSO 都会在迭代中拾取它们。
除此之外，如果文件不是有效的 PPT 文件类型（PPT、PPTX、PPTM、XML 等），我也会遇到类似的错误。如果有错误，我使用以下代码在即时窗口中打印错误日志（并通过 MsgBox 提示通知您）。
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