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
精彩评论