批量导出ppt中的备注（亲测可用）

大多数教程采用的是导出大纲的方式，但是博主导出大纲经常失败，于是找到了这篇文章，里面提到了一种新的方法。如何批量导出 PowerPoint 中的备注到一个txt文本中【最简单最强版】
又咨询gpt得到了一个导出word的脚本

点击查看代码

Sub ExportNotesToWord()
    Dim pptSlide As Slide
    Dim pptNotes As String
    Dim i As Integer
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim FilePath As String

    ' 设置保存路径和文件名
    FilePath = "C:\Export\All_Notes.docx"
    
    ' 检查路径是否存在
    If Dir("C:\Export\", vbDirectory) = "" Then
        MsgBox "路径不存在，请先创建目录：C:\Export\"
        Exit Sub
    End If

    ' 创建 Word 应用程序对象
    On Error Resume Next
    Set WordApp = CreateObject("Word.Application")
    On Error GoTo 0
    
    If WordApp Is Nothing Then
        MsgBox "无法启动 Word 应用程序，请确保已安装 Microsoft Word。"
        Exit Sub
    End If

    ' 创建新的 Word 文档
    Set WordDoc = WordApp.Documents.Add
    
    ' 遍历每张幻灯片
    For Each pptSlide In ActivePresentation.Slides
        i = i + 1
        
        On Error Resume Next
        pptNotes = pptSlide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
        On Error GoTo 0
        
        ' 写入幻灯片编号和备注到 Word 文档
        WordDoc.Content.InsertAfter "Page " & i & ":" & vbCrLf
        WordDoc.Content.InsertAfter pptNotes & vbCrLf & vbCrLf
    Next pptSlide

    ' 保存 Word 文档
    WordDoc.SaveAs FilePath
    WordDoc.Close
    WordApp.Quit

    ' 清理对象
    Set WordDoc = Nothing
    Set WordApp = Nothing

    MsgBox "备注已导出到：" & FilePath
End Sub

秒导出成功。。。