私のVBAコードにエラーがあります

Question

私はVBAを使用して複数のPPTXファイルをPDFに変換するのに以下のコードを使用していますが、エラーが発生しています。

私が使用していたコード。

Const ppSaveAsPDF As Long = 32 

Sub pptxtopdf() 

Dim ppt As Object 
Dim objFSO As Object 
Dim objFolder As Object 
Dim objFile As Object 
Dim i As Integer 

On Error Resume Next 

Set ppt = GetObject(, "PowerPoint.Application") 
If ppt Is Nothing Then 
    Set ppt = CreateObject("PowerPoint.Application") 
End If 
On Error GoTo 0 

'Create an instance of the FileSystemObject 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
'Get the folder object 
Set objFolder = objFSO.GetFolder("Y:\Desktop\Month End\One_Shot\Template AVP Report Package") 
i = 1 
'loops through each file in the directory 
For Each objFile In objFolder.files 
    Set WDReport = ppt.Presentations.Open(objFile.Path) 

    Dim FileName2 As String 
    FileName2 = Replace(objFile.Path, "pptx", "pdf") 

    'WDReport.ExportAsFixedFormat FileName2, ppFixedFormatTypePDF 
    WDReport.SaveAs FileName2, ppSaveAsPDF 

    WDReport.Close 
    ppt.Quit 

    Set ppt = Nothing 
    Set WDReport = Nothing 

    i = i + 1 
Next objFile 

End Sub 

私はエラー状態

実行時エラー '-247024773（8007007b'）

Set WDReport = ppt.Presentations.Open(objFile.Path) 

でエラーを取得しています：メソッド「オブジェクト 「プレゼンテーションの開く

に失敗しました

私は紛失しているものについてアドバイスしていただけますか？ こっちで ？

Answer 1

オリジナルのコードをテストすると、私のフォルダにPowerPointプレゼンテーション（.pptxまたは.pptmフォーマットではありません）以外のファイルもあるため、同じエラーが表示されます。

だから、あなたが次の行を追加する必要があり、このエラーを処理するために：

If UCase(Right(objFile.Name, 4)) = "PPTX" Or UCase(Right(objFile.Name, 4)) = "PPTM" Then 

コード

Const ppSaveAsPDF As Long = 32 

Sub pptxtopdf() 

Dim ppt As Object 
Dim objFSO As Object 
Dim objFolder As Object 
Dim objFile As Object 
Dim i As Integer 
Dim FileName2 As String 

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

If ppt Is Nothing Then 
    Set ppt = CreateObject("PowerPoint.Application") 
End If 

'Create an instance of the FileSystemObject 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
'Get the folder object 
Set objFolder = objFSO.GetFolder("J:\PMO\Project Status Meeting Material\R&D weekly report\2017\Work Folder 03-12-17") ' ("Y:\Desktop\Month End\One_Shot\Template AVP Report Package") 
i = 1 

'loops through each file in the directory 
For Each objFile In objFolder.Files 
    ' === make sure current file is PowerPoint === 
    If UCase(Right(objFile.Name, 4)) = "PPTX" Or UCase(Right(objFile.Name, 4)) = "PPTM" Then 
     Set WDReport = ppt.Presentations.Open(objFile.Path, msoFalse) ' open as read only 

     FileName2 = Replace(objFile.Path, "pptx", "pdf") 

     WDReport.SaveAs FileName2, ppSaveAsPDF 
     WDReport.Close 

     Set WDReport = Nothing 
     i = i + 1 
    End If 
Next objFile 

' move this outside the loop 
ppt.Quit 
Set ppt = Nothing 

End Sub