用於打開和編輯多個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