파워포인트VBA_스닙펫:파워포인트 메모를 모두 텍스트 파일로 익스포트

ExportNotesText.bas

'작성일 : 2012.09.05
'작성자 : 서재원
'출처 : http://support.microsoft.com/kb/2669736/ko
'설명 : 파워포인트용 VBA모듈
' 파워포인트 메모를 모두 텍스트 파일로 익스포트 한다.

Sub ExportNotesText()

	Dim oSlides As Slides
	Dim oSl As Slide
	Dim oSh As Shape
	Dim strNotesText As String
	Dim strFileName As String
	Dim intFileNum As Integer
	Dim lngReturn As Long

	' Get a filename to store the collected text
	strFileName = InputBox("Enter the full path and name of file to extract notes text to", "Output file?")
	' did user cancel?
	If strFileName = "" Then 
		Exit Sub
	End If

	' is the path valid? crude but effective test: try to create the file.
	intFileNum = FreeFile()
	On Error Resume Next
	Open strFileName For Output As intFileNum
	If Err.Number <> 0 Then ' we have a problem
		MsgBox "Couldn't create the file: " & strFileName & vbCrLf & "Please try again."
		Exit Sub
	End If

	Close #intFileNum ' temporarily

	' Get the notes text

	Set oSlides = ActivePresentation.Slides

	For Each oSl In oSlides
		For Each oSh In oSl.NotesPage.Shapes
			If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then
				If oSh.HasTextFrame Then
					If oSh.TextFrame.HasText Then
						strNotesText = strNotesText & "Slide: " & CStr(oSl.SlideIndex) & vbCrLf & oSh.TextFrame.TextRange.Text & vbCrLf & vbCrLf
					End If
				End If
			End If
		Next oSh
	Next oSl

	' now write the text to file
	Open strFileName For Output As intFileNum
	Print #intFileNum, strNotesText
	Close #intFileNum
	' show what we've done
	lngReturn = Shell("NOTEPAD.EXE " & strFileName, vbNormalFocus)
End Sub