VBA用於打開和編輯多個Powerpoint文件

Question

我有一個包含200多個Powerpoint文件的文件夾，而且我一直在努力使用宏來打開每個文件，對其進行編輯，保存並在循環中將其關閉。 我已經為編輯部分創建了代碼，但是我無法創建用於選擇文件夾中每個文件的代碼。 使用"*.pptx"似乎不起作用，並且為每個文件使用特定文件名編寫代碼的效率非常低。

有人對此有解決方案嗎？

Sub SaveNotesText()

Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide As Slide
Dim oShapes As Shapes
Dim oSh As Shape
Dim NotesText As String
Dim FileNum As Integer
Dim PathSep As String

#If Mac Then
    PathSep = ":"
#Else
    PathSep = "\"
#End If

Set oPres = ActivePresentation
Set oSlides = oPres.Slides

For Each oSlide In oSlides
    NotesText = NotesText & "Slide " & oSlide.SlideIndex & vbCrLf
    Set oShapes = oSlide.NotesPage.Shapes
    For Each oSh In oShapes
        If oSh.HasTextFrame Then
            If oSh.TextFrame.HasText Then
                NotesText = NotesText & oSh.TextFrame.TextRange.Text
            End If
        End If
    Next oSh
    NotesText = NotesText & vbCrLf
Next oSlide

FileNum = FreeFile
Open oPres.Path & PathSep & "NotesText.TXT" For Output As FileNum
Print #FileNum, NotesText
Close FileNum

End Sub

http://www.pptfaq.com/FAQ00274.htm

Answer 1

您可以使用Dir循環瀏覽文件夾中的所有“＃.ppt＃”文件，即

Public Sub DoFiles()
    Dim strFileName As String
    Dim strFolderName As String
    Dim PP As Presentation
    'set default directory here if needed
    strFolderName = "C:\temp"
    strFileName = Dir(strFolderName & "\*.ppt*")
    Do While Len(strFileName) > 0
       Set PP = Presentations.Open(strFolderName & "\" & strFileName)
        'your code
        PP.Close
        strFileName = Dir
    Loop
End Sub