开发者

VBA for opening and editing multiple Powerpoint files

I have a folder with over 200 Powerpoint files and I have been have been struggling with a Macro that opens each of these files, edits them, saves them and closes them in a loop. I have managed to create code for the editing part, however I can't manage to create a code that picks each of the files in the folder. Using "*.pptx" doesn't seem to work and writing code with a specific filename for each of these files is very inefficient.

Does anyone have a solution to this?

Sub SaveNotesText()

Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide As Slide
Dim oShapes As Shape开发者_运维问答s
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


You can use Dir to loop through all the "#.ppt#" files in a folder, ie

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
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜