Bob, & all;
Here is the code I came up with so far. It works to a point. Actually, the
only complaint I have is that I end up with many, many, many instances of
PowerPoint loaded as this program loops.
I tried a couple of things, but can't get rid of this problem.
Look it over and perhaps we can get something working.
Oh, yes. What is going on here is I am reading a text file created by
another program and playing the files marked 'Y'. There are only 8 files,
hence the loop '1 to 8'.
The input file looks like this:
WelcomeSign.ppt;Y
adm.ppt;Y
fin.ppt;Y
rms.ppt;Y
ebs.ppt;Y
hmsr.ppt;Y
rps.ppt;Y
cmsrv.ppt;Y
Here is my code. There are two forms and one Module. Form1 is to start
things off with a button and form2 is just a blue background to obscure the
desktop.
VERSION 5.00
Begin VB.Form Form1
BackColor = &H00C0C0C0&
Caption = "Form1"
ClientHeight = 3630
ClientLeft = 4425
ClientTop = 3150
ClientWidth = 6390
LinkTopic = "Form1"
ScaleHeight = 3630
ScaleWidth = 6390
Begin VB.CommandButton cmdRunShows
Caption = "Run Slide Shows"
BeginProperty Font
Name = "Arial"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 1200
TabIndex = 1
Top = 1680
Width = 3975
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 4080
TabIndex = 0
Top = 2640
Width = 1095
End
Begin VB.Label Label2
Alignment = 2 'Center
BackColor = &H00E0E0E0&
Caption = "Presentations"
BeginProperty Font
Name = "Arial"
Size = 24
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 600
TabIndex = 3
Top = 720
Width = 5175
End
Begin VB.Label Label1
Alignment = 2 'Center
BackColor = &H00E0E0E0&
Caption = "Lobby PowerPoint"
BeginProperty Font
Name = "Arial"
Size = 24
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 600
TabIndex = 2
Top = 120
Width = 5175
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdExit_Click()
Close
End
End Sub
Private Sub cmdRunShows_Click()
'Do
LobbyForm2.Show
AutomatePpt ("")
LobbyForm2.Hide
' DoEvents
'Loop
End Sub
------------ End of lobby.frm (Form1) ----------------------------
VERSION 5.00
Begin VB.Form LobbyForm2
BackColor = &H00FF0000&
Caption = "Lobby - Form2"
ClientHeight = 11010
ClientLeft = 60
ClientTop = 240
ClientWidth = 15240
LinkTopic = "Form2"
ScaleHeight = 11010
ScaleWidth = 15240
End
Attribute VB_Name = "LobbyForm2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
------------ End of lobbyForm2.frm (Form2) ----------------------------
Attribute VB_Name = "Module1"
'--------------------------------------------------------------------------------
'This module is part of the Lobby.vbp.
'
'
--------------------------------------------------------------------------------
Option Explicit
Global PlayMe(8, 2) As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub RunMe()
Dim tmp As String
Dim x, y, z As Integer
Open "f:\public\lobby\yesorno.txt" For Input As #1
'load our array with PPT files to play
For x = 1 To 8
Input #1, tmp
z = InStr(tmp, ";")
PlayMe(x, 1) = Left(tmp, z - 1)
PlayMe(x, 2) = Right(tmp, 1)
Next x
Close #1
DoEvents
'Loop
End Sub
Sub AutomatePpt(PresPath As String)
Dim oPPTApp As Object
Dim oPPTPres As Object
'Dim Wn As SlideShowWindow
Dim Showpos As Integer
Dim iSlides, x, y, z As Integer
Dim tmp As String
On Error Resume Next
Set oPPTApp = CreateObject("PowerPoint.Application")
If Not oPPTApp Is Nothing Then
With oPPTApp
Do 'do until we break out of this loop
RunMe 'get files into array
'Play each PPT file that is marked
For y = 1 To 8
If UCase(PlayMe(y, 2)) = "Y" Then
PresPath = "f:\public\lobby\" & PlayMe(y, 1)
'Call AutomatePpt("f:\public\lobby\" & PlayMe(x, 1))
Set oPPTPres = .Presentations.Open(PresPath, True, , False)
If Not oPPTPres Is Nothing Then
oPPTPres.SlideShowSettings.LoopUntilStopped = False
oPPTPres.SlideShowSettings.Run
iSlides = oPPTPres.Slides.Count
'We need to pause for (iSlides * 5) seconds for the
display to run
Debug.Print Time$
Do While iSlides > 0
For x = 1 To 5 'wait 5 seconds, DoEvents each
second
Sleep (990) 'we are going to wait just 0.990
secs. per Sleep
DoEvents
Next x
iSlides = iSlides - 1
Loop
Debug.Print Time$
Else
MsgBox "The code could not open the specified file." & _
vbCr & Chr$(34) & PresPath & Chr$(34) & vbCr & _
"Check if the file is present at the location.", _
vbCritical + vbOKOnly, "PowerPoint Automation
Example"
Exit Sub
End If
End If
Set oPPTPres = .Presentations.Close
Set oPPTPres = Nothing
Next y
Loop
End With
Else
MsgBox "The code failed to instantiate PowerPoint session.", _
vbCritical + vbOKOnly, "PowerPoint Automation Example"
Exit Sub
End If
oPPTApp.Quit
DoEvents
Set oPPTApp = Nothing
'DoEvents
End Sub
---------End of msg.---------------
