用于打开和编辑多个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

您可以在文件夹中使用方向遍历所有的 “＃.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