I have a powerpoint presentation that opens via visual basic 6 as shown below. It runs for 236 minutes then closes. Then the program restarts it with updated information that is also in the code, but not included here. My problem is I have a stop command button to stop the timer and stop everything. However, since I used the sleep function below, it freezes the program if I try to access it. Is there an alternative to using the sleep function as shown below? I am used to the newer visual basic so vb6 is outdated for me. Can you provide example and include it in the code below? Thanks...
Part when it opens powerpoint and runs slide show...
SPresentationFile = "I:\ISO Documents\QA\SPC Graphs\SPC Presentation.ppt"
Set oPPTApp = New PowerPoint.Application
oPPTApp.Visible = True
Set oPPTPres = oPPTApp.Presentations.Open(SPresentationFile)
oPPTPres.SlideShowSettings.Run
Sleep 140000000
oPPTPres.Close
oPPTApp.Quit
Set oPPTApp = Nothing
Set oPPTPres = Nothing
End Sub.
I thought about doing this but it doesn't seem to work... does anyone have any ideas?
SPresentationFile = "I:\ISO Documents\QA\SPC Graphs\SPC Presentation.ppt"
Set oPPTApp = New PowerPoint.Application
oPPTApp.Visible = True
Set oPPTPres = oPPTApp.Presentations.Open(SPresentationFile)
oPPTPres.SlideShowSettings.Run
If Minutes = 236 Then
oPPTPres.Close
oPPTApp.Quit
Set oPPTApp = Nothing
Set oPPTPres = Nothing
End If
End Sub.
===
===
===
===
===
Whole code
Code:
Option Explicit
Private Minutes As Integer
Dim AccessApp As Object
Dim xlTmp As Excel.Application
Dim xlBook As Excel.Workbook
Dim oPPTApp As PowerPoint.Application
Dim oPPTPres As PowerPoint.Presentation
Dim SPresentationFile As String
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Private Sub cmdStart_Click()
Minutes = 0
Cls
Call DoWork
Timer1.Enabled = True
End Sub
Private Sub cmdStop_Click()
Timer1.Enabled = False
End Sub
Private Sub Form_Load()
Timer1.interval = 60000
End Sub
Private Sub Timer1_Timer()
Minutes = Minutes + 1
If Minutes = 240 Then
Minutes = 0
Call DoWork
End If
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub DoWork()
'Set AccessApp = CreateObject("access.Application")
'AccessApp.Visible = True
'AccessApp.OpenCurrentDatabase "I:\Inspectionsystem\Data\DWDATA2.mdb"
'AccessApp.DoCmd.RunMacro "SPC file updates"
'AccessApp.CloseCurrentDatabase
'AccessApp.Quit
'Set AccessApp = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Set xlTmp = New Excel.Application
'Set xlBook = xlTmp.Workbooks.Open("I:\ISO Documents\QA\SPC Graphs\DD1.XLS")
'xlTmp.Visible = True
'xlBook.Close SaveChanges:=True
'Set xlBook = Nothing
'xlTmp.Quit
'Set xlTmp = Nothing
'Sleep 2000
'Set xlTmp = New Excel.Application
'Set xlBook = xlTmp.Workbooks.Open("I:\ISO Documents\QA\SPC Graphs\DD2.XLS")
'xlTmp.Visible = True
'xlBook.Close SaveChanges:=True
'Set xlBook = Nothing
'xlTmp.Quit
'Set xlTmp = Nothing
'Sleep 2000
'Set xlTmp = New Excel.Application
'Set xlBook = xlTmp.Workbooks.Open("I:\ISO Documents\QA\SPC Graphs\FP.XLS")
'xlTmp.Visible = True
'xlBook.Close SaveChanges:=True
'Set xlBook = Nothing
'xlTmp.Quit
'Set xlTmp = Nothing
'Sleep 2000
'Set xlTmp = New Excel.Application
'Set xlBook = xlTmp.Workbooks.Open("I:\ISO Documents\QA\SPC Graphs\PB-1.XLS")
'xlTmp.Visible = True
'xlBook.Close SaveChanges:=True
'Set xlBook = Nothing
'xlTmp.Quit
'Set xlTmp = Nothing
'Sleep 2000
'Set xlTmp = New Excel.Application
'Set xlBook = xlTmp.Workbooks.Open("I:\ISO Documents\QA\SPC Graphs\PB-3.XLS")
'xlTmp.Visible = True
'xlBook.Close SaveChanges:=True
'Set xlBook = Nothing
'xlTmp.Quit
'Set xlTmp = Nothing
'Sleep 2000
'Set xlTmp = New Excel.Application
'Set xlBook = xlTmp.Workbooks.Open("I:\ISO Documents\QA\SPC Graphs\SRH-012.XLS")
'xlTmp.Visible = True
'xlBook.Close SaveChanges:=True
'Set xlBook = Nothing
'xlTmp.Quit
'Set xlTmp = Nothing
'Sleep 3000
'''''''''''''''''''''''''''''''''''''
'Set xlTmp = New Excel.Application
'Set xlBook = xlTmp.Workbooks.Open("I:\ISO Documents\QA\SPC Graphs\spc summary graphs.xls")
'xlTmp.Visible = True
'xlTmp.Run ("pastetopowerpoint")
'xlBook.Close SaveChanges:=True
'Sleep 5000
'Set xlBook = Nothing
'Set xlTmp = Nothing
''''''''''''''''''''''''''''''''''''''
Dim intStop As Integer
SPresentationFile = "c:\zach.ppt"
Set oPPTApp = New PowerPoint.Application
oPPTApp.Visible = True
Set oPPTPres = oPPTApp.Presentations.Open(SPresentationFile)
oPPTPres.SlideShowSettings.Run
Sleep 14160000
oPPTPres.Close
oPPTApp.Quit
Set oPPTApp = Nothing
Set oPPTPres = Nothing
End Sub
