Export the PowerPoint presentation outline to a tabbed text file

Problem

We'd swear that at one time, PowerPoint could export its outline to a tabbed text file (just like the ones it can import and convert to a presentation quite easily). But the last time we went looking for the feature, it was nowhere to be found.

Solution

VBA, of course. The routine below will export your presentation to a text file that looks like this:

Slide Title
[tab]Bullet Level 1 Text
[tab][tab]Bullet Level 2 Text
[tab][tab][tab]Bullet Level 3 Text
[tab][tab][tab][tab]Bullet Level 4 Text

and so on.

Note:
The default output file is C:\PowerPoint_Outline.txt.
Edit the line indicated below to change that.

Sub PPTOutlineToText()

    Dim oSh As Shape
    Dim oSl As Slide
    Dim oTitleShape As Shape
    Dim oTextshape As Shape
    Dim sPresentationText As String
    Dim x As Long

    ' File variables
    Dim sFilename As String
    Dim iFilenum As Integer
    ' Edit this as needed to change the default
    sFilename = "C:\PowerPoint_Outline.txt"

    On Error GoTo ErrorHandler

    sFilename = InputBox("Enter a full path for the outline text file", "Send outline to", sFilename)
    ' No filename?  No file.
    If sFilename = "" Then
        Exit Sub
    End If

    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes
            If oSh.Type = msoPlaceholder Then
                Select Case oSh.PlaceholderFormat.Type
                    ' A title; add other titletypes as needed
                    Case Is = ppPlaceholderCenterTitle, ppPlaceholderTitle
                        Set oTitleShape = oSh
                    ' body or subtitle text; add others as needed
                    Case Is = ppPlaceholderSubtitle, ppPlaceholderBody
                        Set oTextshape = oSh
                    Case Else

                End Select
            End If  ' Shape is a placeholder
        Next    ' Shape

        ' now we have references to our title and text shapes, if any
        ' append the text to the string we're building
        If Not oTitleShape Is Nothing Then
            sPresentationText = sPresentationText _
                & oTitleShape.TextFrame.TextRange.Text _
                & vbCrLf
        Else
            ' force something as a title;
            ' substitute just vbcrlf if you wish
            sPresentationText = sPresentationText _
                & "Slide " & CStr(oSl.SlideIndex) _
                & vbCrLf
        End If

        If Not oTextshape Is Nothing Then
            For x = 1 To oTextshape.TextFrame.TextRange.Paragraphs.Count
                sPresentationText = sPresentationText _
                    & MakeTabs(oTextshape.TextFrame.TextRange.Paragraphs(x).IndentLevel) _
                    & oTextshape.TextFrame.TextRange.Paragraphs(x).Text
                    ' .Paragraph includes trailing linefeed, so don't add it here
            Next    ' paragraph
            ' Add a newline at end of final paragraph though
            sPresentationText = sPresentationText & vbCrLf
        Else
            ' no need to write anything to the file
        End If

        Set oSh = Nothing
        Set oTitleShape = Nothing
        Set oTextshape = Nothing
    Next    ' Slide

    ' now write the file
    iFilenum = FreeFile()
    Open sFilename For Output As iFilenum
    Print #iFilenum, sPresentationText
    Close iFilenum

NormalExit:
    Exit Sub
ErrorHandler:
    MsgBox "Error:" & vbCrLf & Err.Number & vbCrLf & Err.Description
    Resume NormalExit

End Sub

Function MakeTabs(lIndentLevel As Long) As String
    Dim x As Long
    Dim sTemp As String
    For x = 1 To lIndentLevel
        sTemp = sTemp & vbTab
    Next
    MakeTabs = sTemp
End Function

See How do I use VBA code in PowerPoint? to learn how to use this example code.

Search terms:

---