用于打开和编辑多个 Powerpoint 文件的 VBA

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