run powerpoint in vb

Dim ppapp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim fso, f1, cnow, ctime As Variant
Dim dtBegin As Date, dtEnd As Date
Dim lngElapsedSeconds As Long

Private Sub mnuexit_Click()
Unload Me
End Sub


Private Sub mnuopen_Click()

dlgopen.Filter = "presentations|*.ppt"
dlgopen.ShowOpen

Set ppapp = CreateObject("Powerpoint.Application")

ppapp.Visible = True

Set ppPres = ppapp.Presentations.Open(dlgopen.FileName)

Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.CreateTextFile("c:\pplog.txt", True)

For i = 1 To ppPres.Slides.Count

With ppPres.Slides(i).SlideShowTransition
.EntryEffect = ppEffectRandom
End With

With ppPres.SlideShowSettings
.ShowType = ppShowTypeSpeaker
.RangeType = ppShowAll
.StartingSlide = 1
.EndingSlide = ppPres.Slides.Count
.Run
End With

lngElapsedSeconds = ppPres.SlideShowWindow.View.SlideElapsedTime

If i = 1 Then
dtBegin = Now()
Else
dtBegin = dtEnd
End If

dtEnd = DateAdd("s", lngElapsedSeconds, dtBegin)

f1.WriteLine (Format(dtBegin, "hh:mm:ss") & " - " & Format(dtEnd, "hh:mm:ss") & " " & " Slide" & i)
f1.WriteBlankLines (1)

Next

f1.Close


End Sub
the above code has been created but does not run in normal mode.In debug mode it works perfectly.The main objective is to find out each slides starting & ending time and print it in a txt file