我用此代码的目标是要有一个文件夹PATH,宏将进行搜索并将每个PPT幻灯片插入新的演示文稿中。然后,宏将在下一个子文件夹中查找,并继续此迭代过程,直到将每张幻灯片添加到新的演示文稿中。
我真的很不擅长VBA编码,只是把我在网上可以找到的东西拼凑在一起,以便我可以更快地工作。
Public Sub NonRecursiveMethod()
Dim fso, ofolder, oSubfolder, oFile, queue As Collection
Dim vArray As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("\\PATH") 'obviously replace
Do While queue.Count > 0
Set ofolder = queue(1)
queue.Remove 1 'dequeue
'I don't know if I need to conduct any folder operations
For Each oSubfolder In ofolder.SubFolders
queue.Add oSubfolder 'enqueue
Next oSubfolder
For Each oFile In ofolder.Files
'I understand that I need to call my InsertAllSlides method here, but how?
Next oFile
Loop
End Sub
Sub InsertAllSlides(ByVal ofolder As String)
Dim vArray() As String
Dim x As Long
EnumerateFiles "need to know which variable to add", "*.PPTX", vArray
With ActivePresentation
For x = 1 To UBound(vArray)
If Len(vArray(x)) > 0 Then
Debug.Print vArray(x)
.Slides.InsertFromFile vArray(x), .Slides.Count
End If
Next
End With
End Sub
Sub EnumerateFiles(ByVal sDirectory As String, _
ByVal sFileSpec As String, _
ByRef vArray As Variant)
' collect all files matching the file spec into vArray, an array of strings
Dim sTemp As String
ReDim vArray(1 To 1)
sTemp = Dir$(sDirectory & sFileSpec)
Do While Len(sTemp) > 0
' NOT the "mother ship" ... current presentation
If sTemp <> ActivePresentation.Name Then
ReDim Preserve vArray(1 To UBound(vArray) + 1)
vArray(UBound(vArray)) = sDirectory & sTemp
End If
sTemp = Dir$
Loop
End Sub