Question

我正在寻找VBA代码以遍历文件夹的所有子文件夹，将这些子文件夹中以“ EN”开头的每个Powerpoint文件导出为pdf文件，此新的pdf文件应保存在另一个文件夹中。谢谢您的帮助。

  'It's VBA code that i tried to make 
 Sub loopthrough () 

     Dim folder As Object
     Dim fo As String
     Dim SubFolders As Object
     Dim CurrFile As Object
     Dim foldest As String
     Dim Chemin As String 'path'
     Dim fichier As String 'file'


    Set fso = CreateObject("Scripting.FileSystemObject")
    fo = "C:\Users\samiess\Desktop\resu\"
    Set folder = fso.GetFolder(fo)
    Set SubFolders = folder.SubFolders

     Dim ppAPP As PowerPoint.Application, ppPres As 
     PowerPoint.Presentation
     Set ppAPP = CreateObject("Powerpoint.Application")

     AppActivate Application.Caption

     foldest = "C:\Users\samiess\Desktop\resu\EN\"


     For Each SubFolders In SubFolders

     Set CurrFile = SubFolders.Files

     For Each CurrFile In CurrFile

     If CurrFile Like "*EN*" Then

    chemin = CurrFile
    fichier = Dir(chemin)

    End If


       Next

    Do While Len(fichier) > 0

   Set ppPres = ppAPP.Presentations.Open(fo & fichier)

   ppPres.ExportAsFixedFormat foldest & chemin,_ 
   FixedFormatType:=ppFixedFormatTypePDF

   ppPres.Close
   fichier = Dir()

   Loop
   Next
  End sub

Answer 1

您可以使用以下代码段创建具有所需所有文件名的数组。对不起作者，但我不知道是谁。（无论如何不是我）。

Private Function RFilesList(fileMask As String) As Variant
'recursive file list
'returns an array with full filenames, including subfolders
'fileMask must include folder and file mask, like this: "c:\test\*.xl*"
    RFilesList = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & fileMask & """ /s/b").stdout.readall, vbCrLf)
End Function

遍历子文件夹并将所有ppt文件导出到另一个文件夹[VBA]中的pdf

1 个答案: