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