Sub GatherTitles()
On Error GoTo ErrorHandler
Dim oSlide As Slide
Dim strTitles As String
Dim strFilename As String
Dim intFileNum As Integer
Dim PathSep As String
PathSep = "\"
On Error Resume Next
For Each oSlide In ActiveWindow.Presentation.Slides
   strTitles = strTitles _
   & oSlide.Shapes.Title.TextFrame.TextRange.Text _
   & " Slide: " _
   & CStr(oSlide.SlideIndex) & vbCrLf
   Next oSlide
   On Error GoTo ErrorHandler
intFileNum = FreeFile
strFilename = ActivePresentation.Path _
   & PathSep _
   & Mid$(ActivePresentation.Name, 1, _
   Len(ActivePresentation.Name) - 4) _
   & "_Titles.TXT"
Open strFilename For Output As intFileNum
Print #intFileNum, strTitles
NormalExit:
Close intFileNum
Exit Sub
ErrorHandler:
MsgBox Err.Description
Resume NormalExit
End Sub

Did that answer the question / help?
_____________________________
John Wilson
Microsoft Certified Office Specialist
http://www.technologytrish.co.uk/ppttipshome.html