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

我在

收到错误

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

错误状态

运行时错误＆＃39; -247024773（8007007b）＆＃39;：方法＆＃39;打开对象＆＃34;演示＆＃39;失败

有人可以告诉我这里错过了什么吗？

Answer 1

在测试原始代码时，我得到了与您相同的错误，因为我的文件夹还有其他文件，而不是PowerPoint演示文稿（不是.pptx或.pptm格式），所以它很开心。< / p>

因此，为了处理此错误，您需要添加以下行：

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

我的VBA代码出错

1 个答案: