Hi all,
My VB6 Program wont end correctly unless I use END.
It use to end with an unload me on the last form, but as soon as I open a particular form, it won't end from there. Can someone tell me how to estblish whats still active within my program so I can close it - can't see anything.
My VB6 Program wont end correctly unless I use END.
It use to end with an unload me on the last form, but as soon as I open a particular form, it won't end from there. Can someone tell me how to estblish whats still active within my program so I can close it - can't see anything.
Code:
'Option Explicit
Dim WithEvents oPPTAppEvents As PowerPoint.Application
Dim oPPTApp As PowerPoint.Application
Dim oPPTPres As PowerPoint.Presentation
Dim PresPath As String
Private Sub CompletionofPresentation()
'********************************************************************************
' Check if presentation was completed longer then time
'********************************************************************************
Dim tmp As String
Open "C:\Result.txt" For Input As #1
Line Input #1, Result
Line Input #1, StrResult
Close #1
FinishTime = Format(Now(), "dd-mmm-yy hh:mm:ss")
CompletedMins = DateDiff("n", Txt_Data(4).Text, FinishTime)
Select Case Txt_Data(5).Text
Case "Contractor"
If CompletedMins < Txt_Data(3).Text Then
TimeTaken = "Fail"
Else
TimeTaken = "Pass"
End If
Case "Visitor"
End Select
If TimeTaken = "Fail" Then
MsgBox "You have completed the presentation under the required time allocated - please take again"
MsgBox "You will not be allowed on-site until the presentation is completed correctly"
Tmr_DelayStart.Enabled = True
Exit Sub
End If
If Result = "PASS" Then
MsgBox "Congratulations - Presentation Passed"
Unload Me
Exit Sub
Else
MsgBox "Unfortuntatly you haven't completed the presentation correctly - Retake presentation"
Tmr_DelayStart.Enabled = True
Exit Sub
End If
End Sub
Private Sub Command1_Click()
Call AutomatePowerPoint
End Sub
Sub AutomatePowerPoint()
On Error Resume Next
Select Case Txt_Data(5).Text
Case "Contractor"
'PresPath = "C:\CVMS\VisitorInductionMG NEW.ppsm"
PresPath = Txt_Data(1).Text
Case "Visitor"
PresPath = Txt_Data(0).Text
End Select
Set oPPTApp = CreateObject("PowerPoint.Application")
If Not oPPTApp Is Nothing Then
Set oPPTAppEvents = New PowerPoint.Application
List1.AddItem "All slide show events are being monitored..."
Txt_Data(4).Text = Format(Now(), "dd-mmm-yy hh:mm:ss")
With oPPTApp
Set oPPTPres = .Presentations.Open(PresPath, , , True)
'Set oPPTPres = .Presentations.Open(PresPath, , , False)
If Not oPPTPres Is Nothing Then
oPPTPres.SlideShowSettings.Run
Else
MsgBox "The code could not open the specified file." & _
"Check if the file is present at the location.", _
vbCritical + vbOKOnly, "PowerPoint Automation Example"
End If
End With
Else
MsgBox "The code failed to instantiate PowerPoint session.", _
vbCritical + vbOKOnly, "PowerPoint Automation Example"
End If
End Sub
Private Sub cmdCommand1_Click()
'Set oPPTApp = PowerPoint.Application
'Set oPPTPres = PowerPoint.Presentation
Call AutomatePowerPoint
End Sub
Private Sub HideVB()
Frm_PPS.WindowState = 1
Frm_InductionSignin.WindowState = 1
Frm_Main.WindowState = 1
Frm_Initial.WindowState = 1
End Sub
Private Sub ShowVB()
Frm_InductionSignin.WindowState = 0
Frm_Main.WindowState = 2
Frm_Initial.WindowState = 2
Frm_PPS.WindowState = 0
Frm_PPS.SetFocus
End Sub
Private Sub Form_Load()
Call GetData
' Call filldatamanaual
Tmr_DelayStart.Enabled = True
End Sub
Private Sub GetData()
Dim v_sSQL As String
Dim v_sActiveConnection As String
Dim v_rsFind As New Recordset
Dim AppPassword As String
Dim v_iIndex As Integer
Dim Exe_Version As String
AppPath = Frm_Splash.Txt_Data(0).Text
AppPassword = Frm_Splash.Txt_Data(1).Text
'********************************************************************************
' Opening Database to Get Data
'********************************************************************************
v_sActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AppPath & "; Jet OLEDB:Database Password=" & AppPassword
'********************************************************************************
' gathering location Data for presentations
'********************************************************************************
'SELECT Tbl_Presentations.ID, Tbl_Presentations.Option, Tbl_Presentations.File_Location
'From Tbl_Presentations
'Where (((Tbl_Presentations.Option) = "Contractor"))
'ORDER BY Tbl_Presentations.ID DESC;
v_sSQL = "SELECT Tbl_Presentations.ID, Tbl_Presentations.Option, Tbl_Presentations.File_Location "
v_sSQL = v_sSQL & "From Tbl_Presentations "
v_sSQL = v_sSQL & "Where (((Tbl_Presentations.Option) = 'Contractor')) "
v_sSQL = v_sSQL & "ORDER BY Tbl_Presentations.ID DESC "
v_rsFind.Open v_sSQL, v_sActiveConnection
Txt_Data(1).Text = v_rsFind.Fields!File_Location ' Location
v_rsFind.Close
'SELECT Tbl_Presentations.ID, Tbl_Presentations.Option, Tbl_Presentations.File_Location
'From Tbl_Presentations
'Where (((Tbl_Presentations.Option) = "Visitor"))
'ORDER BY Tbl_Presentations.ID DESC;
v_sSQL = "SELECT Tbl_Presentations.ID, Tbl_Presentations.Option, Tbl_Presentations.File_Location "
v_sSQL = v_sSQL & "From Tbl_Presentations "
v_sSQL = v_sSQL & "Where (((Tbl_Presentations.Option) = 'Visitor')) "
v_sSQL = v_sSQL & "ORDER BY Tbl_Presentations.ID DESC "
v_rsFind.Open v_sSQL, v_sActiveConnection
Txt_Data(0).Text = v_rsFind.Fields!File_Location ' Location
v_rsFind.Close
'********************************************************************************
' gathering Time limits for presentations
'********************************************************************************
'SELECT Tbl_Options.Options, Tbl_Options.Data1
'From Tbl_Options
'WHERE (((Tbl_Options.Options)="ContractorPresTimeLimit"));
v_sSQL = "SELECT Tbl_Options.Options, Tbl_Options.Data1 "
v_sSQL = v_sSQL & "From Tbl_Options "
v_sSQL = v_sSQL & "WHERE (((Tbl_Options.Options)='ContractorPresTimeLimit')) "
v_rsFind.Open v_sSQL, v_sActiveConnection
While Not v_rsFind.EOF
v_iIndex = v_iIndex + 1
Txt_Data(3).Text = v_rsFind.Fields!Data1 ' Location
v_rsFind.MoveNext
Wend
v_rsFind.Close
'********************************************************************************
' gathering Time limits for presentations
'********************************************************************************
'SELECT Tbl_Options.Options, Tbl_Options.Data1
'From Tbl_Options
'WHERE (((Tbl_Options.Options)="VisitorPresTimeLimit"));
v_sSQL = "SELECT Tbl_Options.Options, Tbl_Options.Data1 "
v_sSQL = v_sSQL & "From Tbl_Options "
v_sSQL = v_sSQL & "WHERE (((Tbl_Options.Options)='VisitorPresTimeLimit')) "
v_rsFind.Open v_sSQL, v_sActiveConnection
While Not v_rsFind.EOF
v_iIndex = v_iIndex + 1
Txt_Data(2).Text = v_rsFind.Fields!Data1 ' Location
v_rsFind.MoveNext
Wend
v_rsFind.Close
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
Set oPPTPres = Nothing
oPPTApp.Quit
Set oPPTApp = Nothing
End Sub
Private Sub oPPTAppEvents_SlideShowBegin( _
ByVal Wn As PowerPoint.SlideShowWindow)
List1.AddItem "Slide show has begun..."
Call HideVB
End Sub
Private Sub oPPTAppEvents_SlideShowEnd( _
ByVal Pres As PowerPoint.Presentation)
List1.AddItem "Slide show has terminated"
Call ShowVB
Set oPPTPres = Nothing
Set oPPTApp = Nothing
Set oPPTAppEvents = Nothing
' Call CompletionofPresentation
End Sub
Private Sub oPPTAppEvents_SlideShowNextBuild( _
ByVal Wn As PowerPoint.SlideShowWindow)
List1.AddItem vbTab & "Slide show next build..."
End Sub
Private Sub oPPTAppEvents_SlideShowNextSlide( _
ByVal Wn As PowerPoint.SlideShowWindow)
List1.AddItem "Next slide event..."
List1.AddItem vbTab & "Current slide: " & Wn.View.Slide.SlideIndex
End Sub
Private Sub Tmr_DelayStart_Timer()
Tmr_DelayStart.Enabled = False
Call AutomatePowerPoint
End Sub
Private Sub filldatamanaual()
Txt_Data(5).Text = "Visitor"
Txt_Data(0).Text = "C:\CVMS\UTCVisitorV1_0.cvms"
End Sub
HELP!!!!!