フォルダー中のパワーポイントのファイルをすべて印刷するには?

Question 85.6 Excel VBA Borad (掲示板)より Previous Next
フォルダーの中のパワーポイントのファイル (*.ppt) を、すべて印刷したいのです。
いろいろなサイトを検索して調べたのですが、エクセルはたくさん資料があったのですが、パワーポイントの資料があまりなかったので、質問しました。  下記マクロは見よう見まねで作りましたが、ぜんぜん動きませんでした。
Sub フォルダー内印刷ppt()
    With Application.FileSearch
        .LookIn = "C:\\"
        .Filename = "*.ppt"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                Presentations.Open Filename:=.FoundFiles(i)
                For Each st In Presentations
                    st.Select
                    st.PrintOut
                Next st
                ActivePresentation.Close False
            Next i
            MsgBox "全シートの印刷が終わりました。"
        Else
            MsgBox "このフォルダにExcelファイルはありません。"
        End If
    End With
End Sub
初心者ですいません。よろしくお願いします。
Answer   2007.11.4 井川はるき
PowerPointVBAということであれば、元のコードをあまりいじらなければ、下記のような感じだと思います。(※ 赤字部分は主な修正カ所)
Sub フォルダー内印刷ppt()
    With Application.FileSearch
        .LookIn = "C:\"
        .Filename = "*.ppt"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                With Presentations.Open(.FoundFiles.Item(i))
                    .PrintOut
                    .Close False
                End WithWith
            Next i
            MsgBox "全プレゼンテーションの印刷が終わりました。"
        Else
            MsgBox "このフォルダにPowerPointプレゼンテーションはありません。"
        End If
    End With
End Sub
この処理はPowerPointVBAで完結することなので、まずないとは思いますけど、 ExcelVBAの掲示板ですので、一応ExcelからPowerPointをリモートする場合の コードも書いておきます。
  Dim ff As Office.FoundFiles
  Dim p As Variant
  With Excel.Application.FileSearch
    .LookIn = "C:\"
    .Filename = "*.ppt"
    If .Execute() > 0 Then
      Set ff = .FoundFiles
      With CreateObject("PowerPoint.Application")
        For Each p In ff
          With .Presentations.Open(CStr(p))
            .PrintOut
            .Close False
          End With
        Next
        .Quit
      End With
      Set ff = Nothing
      MsgBox "全プレゼンテーションの印刷が終わりました。"
    Else
      MsgBox "このフォルダにPowerPointプレゼンテーションはありません。"
    End If
  End With
なお、共通して言えることですが、サブフォルダまで検索する場合には、 Office.FileSearchオブジェクトのSearchSubFoldersプロパティの値に Trueを指定してください。
ただし、Cドライブをすべてなめさせるようなことは、APIを使っても 相当にしんどい処理ですので、FileSearchやFSOなどの鈍速のクラスを使うのは 避けた方が賢明です。

Excel VBA Macro