打開方法無法從ppt打開ppt

我在這里遇到了一些麻煩。我的代碼因運行時錯誤 -2147467259 (80004005) 物件“演示文稿：失敗”的方法“打開”而停止。

此代碼顯示警告，提示輸入源檔案夾和目標檔案夾，并回圈遍歷源檔案夾中的所有檔案，打開每個檔案并將每張幻燈片匯出為單個檔案，然后再次直到檔案夾中的最后一個檔案。

我放了幾個 msgboxes 看看是不是名字有問題，根據 MVP Andy Pope 的一些代碼重寫了打開的檔案段，但沒有。

任何幫助深表感謝。

Sub ExportIndividualSlides()
    ''Application.DisplayAlerts = False
    
    Dim ObjPPAPP As New PowerPoint.Application
    Dim objPPPres As PowerPoint.Presentation
    Dim objPPSlide As PowerPoint.Slide
    
    'Initial directory path.
    Dim SourceFolder As String
    Dim TargetFolder As String
    SourceFolder = "c:\source"
    TargetFolder = "c:\target"
    
    Dim Slide As Long
    Dim SourcePresentation As Presentation
    Dim SourcePresentationName As String
    Dim TargetFileName As String
    Dim SourceNamePath
    
    Debug.Print "-- Start --------------------------------"
    
    ActiveWindow.ViewType = ppViewNormal
    
    'Loop through ppt* files only in source folder
       
        SourcePresentationName = Dir(SourceFolder & "\*.ppt*")
            
        MsgBox "SPN:" & SourcePresentationName
            
        While (SourcePresentationName <> "")
            
            SourceNamePath = SourceFolder & "\" & SourcePresentationName
            Debug.Print "   SourceNamePath"
            
            MsgBox SourceNamePath
            
            Set ObjPPAPP = New PowerPoint.Application
            ObjPPAPP.Visible = True
            Set objPPPres = ObjPPAPP.Presentations.Open(SourceNamePath)
            
        '    On Error GoTo errorhandler
            
            ' Open source files
            Set SourcePresentation = Presentations.Open(FileName:=SourcePresentationName, WithWindow:=False)
            Debug.Print "   SourcePresentation: " & SourcePresentation.Name
        
            ' Loop through slides
            For Slide = 1 To SourcePresentation.Slides.Count
            Debug.Print "   Slide: " & Slide
               
                ' Create a unique filename and save a copy of each slide
                TargetFileName = Left(SourcePresentation.Name, InStrRev(SourcePresentation.Name, ".") - 1) & " [" & Slide & "].pptx"
                TargetNamePath = TargetFolder & "\" & TargetFileName
                Debug.Print "   TargetNamePath: " & TargetNamePath
                SourcePresentation.Slides(Slide).Export TargetNamePath, "PPTX"
            
            Next Slide
            objPPPres = Nothing
            SourcePresentation.Close
            SourcePresentationName = Dir
        Wend
    
    
      On Error GoTo 0
      Exit Sub
     
errorhandler:
      Debug.Print Err, Err.Description
      Resume Next
    
End Sub

uj5u.com熱心網友回復：

這對我有用：

Sub ExportIndividualSlides()
    'use const for fixed values
    Const SOURCE_FOLDER As String = "c:\source\" 'include terminal \
    Const TARGET_FOLDER As String = "c:\target\"
    
    Dim objPres As PowerPoint.Presentation
    Dim Slide As Long
    Dim SourcePresentationName As String
    Dim TargetFileName As String
    Dim TargetNamePath As String
    Dim SourceNamePath
    
    Debug.Print "-- Start --------------------------------"
    ActiveWindow.ViewType = ppViewNormal
    
    On Error GoTo errorhandler
    
    'Loop through ppt* files only in source folder
    SourcePresentationName = Dir(SOURCE_FOLDER & "*.ppt*")
    Do While Len(SourcePresentationName) > 0
        
        SourceNamePath = SOURCE_FOLDER & SourcePresentationName
        Debug.Print "Opening: " & SourceNamePath
        
        Set objPres = Presentations.Open(SourceNamePath)
        
        ' Loop through slides
        For Slide = 1 To objPres.Slides.Count
            
            Debug.Print "   Slide: " & Slide
            ' Create a unique filename and save a copy of each slide
            TargetFileName = Left(objPres.Name, InStrRev(objPres.Name, ".") - 1) & " [" & Slide & "].pptx"
            TargetNamePath = TARGET_FOLDER & TargetFileName
            Debug.Print "   TargetNamePath: " & TargetNamePath
            objPres.Slides(Slide).Export TargetNamePath, "PPTX"
        
        Next Slide
        
        objPres.Close
        
        SourcePresentationName = Dir() 'next file
    Loop
    
    Exit Sub
     
errorhandler:
    Debug.Print Err, Err.Description
    Resume Next
    
End Sub

標籤：vba 微软幻灯片软件

上一篇：我如何在vba中將引數傳遞給函式

下一篇：在訪問中創建查詢