Ошибка Excel VBA 467 при попытке открыть презентацию PowerPoint

Question

Цель кода: если PowerPoint открыт и поиск по умолчанию открыт, а затем обновите его. Если презентация закрыта, откройте ее. Если PowerPoint закрыт, создайте новый экземпляр.

Ошибка: после того, как несколько пользователей побежали на на Mulitple компьютеров за последние 2 недели, сегодня один из пользователей получают следующее сообщение об ошибке:

Run-Time Error 467: Машина удаленного сервера не существует или недоступен

код строки highlightned режим отладки:

Set ppPres = ppProgram.Presentations.Item(i) 

Соответствующий раздел модуля Кодекса:

Public Sub UpdatePowerPoint(PowerPointFile) 

Dim ppProgram       As PowerPoint.Application 
Dim ppPres        As PowerPoint.Presentation 
Dim ppFullPath       As String 
Dim ppName        As String 
Dim activeSlide       As PowerPoint.Slide 

Dim cht         As Excel.ChartObject 
Dim myShape        As Object 
Dim myChart        As Object 
Dim SlideNum, GPLRank     As Integer 
Dim ShapeNum       As Integer 
Dim shapeStageStat      As Shape 

On Error Resume Next 
Set ppProgram = GetObject(, "PowerPoint.Application") 
On Error GoTo 0 

ppFullPath = PowerPointFile 
PPT_Export_Success = True 

' check if PowerPoint instance is open 
If ppProgram Is Nothing Then 
    Set ppProgram = New PowerPoint.Application 
    i = 1 
Else 
    If ppProgram.Presentations.count > 0 Then 
     ppName = Mid(ppFullPath, InStrRev(ppFullPath, "\") + 1, Len(ppFullPath)) 
     i = 1 
     ppCount = ppProgram.Presentations.count 
     Do Until i = ppCount + 1 
      If ppProgram.Presentations.Item(i).Name = ppName Then 
       Set ppPres = ppProgram.Presentations.Item(i) 
       GoTo OnePager_Pres_Found 
      Else 
       i = i + 1 
      End If 
     Loop 
    End If 
End If 

ppProgram.Presentations.Open Filename:=PowerPointFile 

' *** Getting the ERROR at the line below *** 
Set ppPres = ppProgram.Presentations.Item(i) 

OnePager_Pres_Found: 
ppPres.Windows(1).Activate ' activate the One-Pager Presentation in case you have several open, and the One_pager is currently not the app "on-focus" 

' --- Added Class script to allow PowerPoint ScreenUpdating set to FALSE --- 
Dim myClass_PPT       As Class_PPT 

Set myClass_PPT = New Class_PPT 
myClass_PPT.ScreenUpdating = False 

' loop through all PowerPoint Slides, and copy all Chart objects from Excel 
For ProjectCounter = 0 To NumberofProjectShts 
    ' copying charts, shapes and other objects 

Next ' ProjectCounter = 0 To NumberofProjectShts 

AppActivate ("Microsoft PowerPoint") 
Set activeSlide = Nothing 
Set ppPres = Nothing 
Set ppProgram = Nothing 

End Sub 

Answer 1

Ваш код - экстракт ниже - выглядит немного странно для меня:

' check if PowerPoint instance is open 
If ppProgram Is Nothing Then 
    Set ppProgram = New PowerPoint.Application 
    i = 1 
Else 
    If ppProgram.Presentations.count > 0 Then 
     ppName = Mid(ppFullPath, InStrRev(ppFullPath, "\") + 1, Len(ppFullPath)) 
     i = 1 
     ppCount = ppProgram.Presentations.count 
     Do Until i = ppCount + 1 
      If ppProgram.Presentations.Item(i).Name = ppName Then 
       Set ppPres = ppProgram.Presentations.Item(i) 
       GoTo OnePager_Pres_Found 
      Else 
       i = i + 1 
      End If 
     Loop 
    End If 
End If 

ppProgram.Presentations.Open Filename:=PowerPointFile 

' *** Getting the ERROR at the line below *** 
Set ppPres = ppProgram.Presentations.Item(i) 

OnePager_Pres_Found: 
ppPres.Windows(1).Activate ' activate the One-Pager Presentation in case you have several open, and the One_pager is currently not the app "on-focus" 

В случае Powerpoint открыт с некоторыми презентациями, но а не тот, который вы хотите (PowerPointFile), на строке, которая дает вам ошибку, что вы пытаетесь сделать? (i равно Презентации.count)

Я думаю, что это неправильно и должно быть заменено ActivePresentation, только что открытым на линии раньше.

Возможно, вы можете немного изменить структуру кода, чтобы иметь более четкую структуру/обработку корпуса.