Computer Hope
Software => Computer programming => Topic started by: blastman on March 07, 2008, 04:31:55 AM
-
Hello all,
I have 3 machines dotted around the office that run powerpoint slide shows. I'd like to be able to email the slideshow to the machine's and have outlook save, open and run the slideshows for me.
I can already do all of this but I'm having problems when the vba code exit's. It seems to close PowerPoint as well.
I require the code to exit so that it can start the process again when the next mail comes in, however PowerPoint once started in this way won't stay open after the code exit's.
I have tried adding a do until loop in so the slideshow keeps running, but that doesn't work as the code is still looping and so doesn't recognises that a new mail has come in (with update slideshow to be played)
Is there anyway of starting PowerPoint with my settings for the slideshow and then exit the code without closing PowerPoint??
Or, is there a way of looping at the bottom of the 'open_PowerPoint' sub but still have the 'do events' of the incoming mail triggered??
cheers in advance.
-
You might try creating the Outlook object within your PowerPoint application. Once you have an instance of Outlook, you can determine if a new email has arrived, save the attachment, and start the slideshow with the newest data.
THis could also be done the other way around. You could create a PowerPoint object within the Outlook application.
Another possibility would be an external script where you could create instances of both Outlook and Powerpoint.
8)
It wasn't clear what happens if no new slideshow arrives. Does PowerPoint shutdown or continue to loop with the old data?
-
You might try creating the Outlook object within your PowerPoint application. Once you have an instance of Outlook, you can determine if a new email has arrived, save the attachment, and start the slideshow with the newest data.
THis could also be done the other way around. You could create a PowerPoint object within the Outlook application.
Another possibility would be an external script where you could create instances of both Outlook and Powerpoint.
8)
It wasn't clear what happens if no new slideshow arrives. Does PowerPoint shutdown or continue to loop with the old data?
All these machines do is display this sideshow. The only emails it will receive will have a updated sideshow on them, so on the first time run it will save the attchment to the machine, and then run it with settings set from outlook.
I'm very new to vba so I'll have look up some of the suggestions, but cheers.
I Like the idea of another script handling both, but could powerpoint be told to open as a slideshow with verious settings (including time on each side etc, etc..)
Could a powerpoint file be opened with my settings with a pre-made premade macro???
Cheers
-
I'm thinking this should be an Outlook application. I fairly certain Outlook has a NewMail event. When the event fires, Outlook can save the attachment, create a Powerpoint application, setup the settings and run the slideshow.
You might find these snippets helpful (courtesy The Scripting Guys (http://www.microsoft.com/technet/scriptcenter/resources/qanda/default.mspx))
Save Outlook Attachment:
Const olFolderInbox = 6
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set colItems = objFolder.Items
Set colFilteredItems = colItems.Restrict("[UnRead] = 'True'")
For Each objMessage In colFilteredItems
intCount = objMessage.Attachments.Count
If intCount > 0 Then
For i = 1 To intCount
objMessage.Attachments.Item(i).SaveAsFile "C:\Temp\" & _
objMessage.Attachments.Item(i).FileName
Next
End If
Next
Run a Slideshow:
Const ppAdvanceOnTime = 2
Const ppShowTypeKiosk = 3
Const ppSlideShowDone = 5
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Open("c:\scripts\Process.ppt")
objPresentation.Slides.Range.SlideShowTransition.AdvanceTime = 2
objPresentation.Slides.Range.SlideShowTransition.AdvanceOnTime = TRUE
objPresentation.SlideShowSettings.AdvanceMode = ppAdvanceOnTime
objPresentation.SlideShowSettings.ShowType = ppShowTypeKiosk
objPresentation.SlideShowSettings.StartingSlide = 1
objPresentation.SlideShowSettings.EndingSlide = _
objPresentation.Slides.Count
Set objSlideShow = objPresentation.SlideShowSettings.Run.View
Do Until objSlideShow.State = ppSlideShowDone
Loop
The snippets are VBScript, but should give you some ideas of what you can accomplish. VBA is not nearly as wordy. ;)
Good luck 8)
-
lol, I have already seen that site.
I have code very similar to that. The issue is that while the module that starts powerpoint is looping to keep it open, the outlook script doesn't fire the NewMail event as it waiting for that module to finish before it returns to the main outlook script to close.
Because of this, when i email a new slideshow to the machines, nothing happens as the script is still running and doesn't see the new mail.
-
OK, I'm lost. The code that controls the slideshow is in the Outlook application, correct?
is there a way of looping at the bottom of the 'open_PowerPoint' sub
I'm guessing you're launching the Powerpoint application from Outlook and then relying on open_PowerPoint to run the slideshow. Not certain how this would work since Outlook and Powerpoint have no way of communicating what each is doing. Could create a real messy conflict if Outlook tries to save the file from which Powerpoint is reading.
If the NewMail event fires, save the attachment, create an instance of Powerpoint, run the slideshow and destroy the Powerpoint instance all within the Outlook application. When the attachment is saved do you rewrite the current Powerpoint source file?
I did find out that if you receive multiple emails at once, the NewMail event only fires once. Also consider how to filter out any junk mail that may arrive by accident.
Hope this helps. 8)
In my previous post I recommended VBScript, but further research shows that VBScript might not be a good solution.
-
OK, I'm lost. The code that controls the slideshow is in the Outlook application, correct?
Yes that's correct.
If the NewMail event fires, save the attachment, create an instance of Powerpoint, run the slideshow and destroy the Powerpoint instance all within the Outlook application. When the attachment is saved do you rewrite the current Powerpoint source file?
Yes that's also correct. As the only mail this machine will receive is an updated slideshow, it needs to close powerpoint, overwrite the last attachment and then open it again.
In my previous post I recommended VB Script, but further research shows that VBScript might not be a good solution.
Can you expand on this??
I have also been looking at this option. Something along the lines of:
outlook, closing powerpoint if open, saving attachment and starting vbs script.
vbs script, starting slideshow and loop until powerpoint closes (by outlook)
what do you reckon???
(cheers for your help so far!!)
-
Quote from: Sidewinder on March 07, 2008, 02:52:52 PM
In my previous post I recommended VB Script, but further research shows that VBScript might not be a good solution.
Can you expand on this??
My first thought was to setup an Outlook rule (Tools-->Rules Wizard) so when a email arrived with say, slideshow in the subject line it would fire off an external script which would save the attachment and run the slideshow. This creates a timing problem however...what happens if an email arrives and a slideshow is in progress? Now you've got multiple copies of an external script conflicting with each other.
I have also been looking at this option. Something along the lines of:
outlook, closing powerpoint if open, saving attachment and starting vbs script.
vbs script, starting slideshow and loop until powerpoint closes (by outlook)
what do you reckon???
I reckon this would be too complicated plus the fact that VBA is not multithreaded, you can either be looping or showing the slideshow but the not both. If you notice in the Powerpoint script that was posted, there is no need to open and close applications. You are dealing with COM objects here. The COM object will do all the pesky detail work.
I would think something a little simpler might work. Write a Application_NewMail() event handler in Outlook. Also create a ShowSlideshow() subroutine in Outlook. Have the event handler call the SlideShow routine if a new email arrives.
The events described above will have Outlook waiting for mail....no mail, no slideshow! If your requirements are to continually show the old slideshow until a new one arrives, you can loop the SlideShow routine with a DoEvents at the bottom.
There might be other ways, but outside of Outlook you lose the NewMail event. You could possibly keep track of the email count in the inbox and if the count increases then you know a new slideshow has arrived.
Just out of curiousity: how long are these slideshows and how often do new ones arrive?
8)
-
They have 2 - 3 sides and run for about an hour before they are updated.
I managed to get it working.....
Outlook - if subject = "march madness" carry on, else exit. It then checks if powerpoint is open and closes if it is. It saves the attachment to a directory and starts a batch file.
Batch file - waits 2 seconds and then starts vbs script then exits.
vbs script - opens the newly saved slideshow with all the correct settings (loopuntilstopped).
The batch file was the key. Because as you rightly said, vba isn't muti-threaded so the batch file starts the vbs script and then exits, fooling outlook to think that the script has finished, thus outlook is ready and waiting to fire the do events when the exit mail comes in.
I'll be honest, there is a small delay in-between the files saving and opening the new one but if it saves me running round 3 machines 9 times a day then it's all good!!!
Thanks for all your help, you have been a star.
Cheers Sidewinder!! ;D
(I'll post the code if your intrested. let me know)
-
I'm glad everything is working. :D
The batch file was the key. Because as you rightly said, vba isn't muti-threaded so the batch file starts the vbs script and then exits, fooling outlook to think that the script has finished, thus outlook is ready and waiting to fire the do events when the exit mail comes in.
A batch file? ::) ARGHHHHHHHHHHHH ;D
-
ummm,
spoke to soon me thinks. :(
the whole thing works as described, but I seem to have multiple wscripts.exe running in task manager. this is causing the machine to slow right down after a few new slideshows opened.
here is the vbs code.
Const ppAdvanceOnTime = 2
Const ppShowTypeKiosk = 3
Const ppSlideShowDone = 5
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Open("C:\march madness\march.ppt")
objPresentation.Slides.Range.SlideShowTransition.AdvanceTime = 5
objPresentation.Slides.Range.SlideShowTransition.AdvanceOnTime = True
objPresentation.SlideShowSettings.AdvanceMode = ppAdvanceOnTime
objPresentation.SlideShowSettings.ShowType = ppShowTypeKiosk
objPresentation.SlideShowSettings.StartingSlide = 1
objPresentation.SlideShowSettings.EndingSlide = 2
objpresentation.slideshowsettings.loopuntilstopped = True
Set objSlideShow = objPresentation.SlideShowSettings.Run.View
Do Until objppt = SlideShowEnd
If Err <> 0 Then
Exit Do
End If
Loop
I'm trying to get it close wscript before it starts, that way I'll only have one version running. My problem is that is closes both wscripts that are open and makes them both to close.
:(
-
Do Until objppt = SlideShowEnd
If Err <> 0 Then
Exit Do
End If
Loop
This piece of code looks murky. Should not you be checking the slideshow object? Also, SlideShowEnd is not defined anywhere, unless I missed it.
I guess I didn't explain too well what the pitfalls of doing it this way were. If there are multiple copies of WScript running, distinguishing one from the other presents an interesting problem. (read: nightmare)
You might be able to write a single external script. As mentioned previously, you'll lose the NewMail event, but you could possibly key off the inbox count. The way it is now, methinks you have too many independent moving parts.
Try taking the two previously posted scripts, combining them into one working script. You could try to have the Run A Slideshow script drive the combined script; after each performance, check the mail, etc. otherwise start a slideshow with whatever data exists.
8)
KISS is not just another four letter word.
-
Hum, good point.
I have managed to get the vbs script to find the process id of the first instance of wscript.exe and kill it, thus fixing the issue.
But I'll be honnest, it is a very 'hacky' way of doing it.
Since it's working now and it 's only intended to be used for the next 2-3 weeks I'll probably leave it there, but not bad for a first timer!!! (even if i do sat so myself!)
Cheers again!!
-
I would put a second sub out there that the loop calls each time it runs. the sub can then check on the status of new email from outlook or a cancel event if you want to put one in. This way as soon as the loop is finished it calls this other sub newmail() and returns some value. If you make the sub boolean (I hope that this is possible) then it will return a true or false value each time. The other sub would be as below.
sub newmail()
Checkmail= outlook.bla.bla (I haven't done any VBA with outlook, but there are examples)
(optional) user_stop= something you input
if checkmail = 1 then
loop_stopper =true
end if
end sub
your loop would then say something like
loop stopper = false
do until loop_stopper=true
newmail (vbval loop_stopper as boolean)
Loop
if loop_stopper = true then
end sub
close powerpoint and don't save
end if
This is just a rough idea, but hopefully you get what I am going for, you need to call out some sort of checking value inside the loop that then goes outside to check the value and then continue looping if needed.
-
Hi,
That's is possible, but i fear I might run it to the same problem I had originally. That was that while the sub was looping to see if there was a newmail, outlook froze and didn't fire the do events for the new mail, thus causing the old slideshow to run forever....
I believe i had done it a different way;
main outlook vba page,
when new mail arrives, set (global) newmail = new
do loads of other stuff, like checking to file is open, making the correct directory's, closing powerpoint and then saving the attachment moving to open() sub
open();
set newmail = nomail
all my powerpoint file/slideshow settings here,
do until newmail = new
if err <> 0 then
exit do
loop
-
Ok, I was thinking of running the vba in powerpoint so as to leave outlook free, though I do not know what effect looping code in VBA with one microsoft program does to the functionality of other MS programs. I guess unless you were willing to let the vba in outlook start up powerpoint and then let it go "hands fee" you would probably have the same problem no matter which ms program was running the original code.
-
Since it's working now and it 's only intended to be used for the next 2-3 weeks I'll probably leave it there, but not bad for a first timer!!!
Congrats! You'll be a whiz by the time March Madness 2009 rolls around. :D
-
Congrats! You'll be a whiz by the time March Madness 2009 rolls around. :D
There is talk of leaving one of the machines with this on, as the sales manager is well impressed. I think he's trying to blag a 50" screen for the display as we speak.
I might have ago at tiding it up a little.
If I posted all the code, would you guys run your eye's over it?? let me know if I could make any changes to improve it??
cheers
-
I'm willing to look it over, and not just because I could use it to set up a movie clip to play on my comp everytime I get new mail :) . I figure it helps to have someone else go through your code as their logic may be different from your own and they may also know of shortcuts that you don't.
-
outlook code (main page)
Public WithEvents TargetFolderItems As Items
Public path As String
Private Sub Application_Startup()
'Declare MAPI folder
Dim ns As Outlook.NameSpace
'Set the default folder
Set ns = Application.GetNamespace("MAPI")
Set TargetFolderItems = ns.GetDefaultFolder(olFolderInbox).Items
Set ns = Nothing
End Sub
Private Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
'Declare attachment & sender variables
Dim olAtt As Attachment
Dim olApp As Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olMyParentFolder As MAPIFolder
Dim olMoveToFolder As MAPIFolder
Dim olNewItem As Object
Dim olSubject As String
Dim olsubjectna As String
Dim olsubjectna1 As String
Dim olsubjectna2 As String
Dim olAttach As String
Dim sender As String
Dim olDate As Date
'exit sub if undeliverable message as errors
olsubjectna = "Undeliverable*"
olsubjectna1 = "Read:*"
olsubjectna2 = "Not Read:*"
If Item.Subject Like olsubjectna Then
Exit Sub
End If
If Item.Subject Like olsubjectna1 Then
Exit Sub
End If
If Item.Subject Like olsubjectna2 Then
Exit Sub
End If
'Declare the sender address
'sender = "[email protected]"
'declare subject criteria (march madness File)
' looks for subject containing "Projection"
olSubject = "*March Madness*"
'If Item.SenderEmailAddress = sender Then
'When a new mail comes into the inbox check to see if it has an attachment and evaluate the sender
'Select Case Item.Subject
'is the mail subject _SALES_TARGET_UPLOAD?
'MsgBox "Mail Received!"
If Item.Subject Like olSubject Then
'pass file/path variable to IsFileOpen function. If True
If IsFileOpen("C:\march madness\March.ppt") = True Then
'MsgBox "condition correct!"
'saves and close's current open ppt
Set objppt = CreateObject("PowerPoint.Application")
objppt.Visible = True
Set objPresentation = objppt.Presentations("C:\march madness\MM Projection v 2.ppt")
objPresentation.Saved = True
objPresentation.Close
objppt.Quit
'MsgBox "Powerpoint closed"
create_directory
End If
Set olAtt = Item.Attachments(1)
olAtt.SaveAsFile "C:\March Madness\" & olAtt
'MsgBox "file saved"
Set objshell = CreateObject("Wscript.Shell")
objshell.Run "C:\powerSTART.bat"
End If
Set olApp = Nothing
Set olNs = Nothing
Set olMyParentFolder = Nothing
Set olMoveToFolder = Nothing
Set olNewItem = Nothing
Set olAtt = Nothing
End Sub
-
outlook modual code;
'declare application and workbook variables
Public objExcel As PowerPoint.Application
Public objWB As PowerPoint.Presentation
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub create_directory()
'MsgBox "got to create directory"
'checks if the march madness folder exist
Dim PoExists As Boolean
'pass arguments to function
PoExists = FileOrDirExists("C:\march madness\")
'if the path(s) don't exist, create directories
If PoExists = False Then
MkDir ("C:\march madness\")
End If
End Sub
Public Function IsFileOpen(FileName As String) As Boolean
'this function checks to see if a file is already open
'returns true if open
'declare variables
Dim iFilenum As Long
Dim iErr As Long
'check for lock file
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
'assign number
iErr = Err
On Error GoTo 0
'select the outcome
Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
'file not found
Case 53: IsFileOpen = False
Case Else: Error iErr
End Select
End Function
Sub delete_from_imported_dir()
On Error GoTo ErrHandler
'delete all files from imported extracts directory
Kill "C:\Oracle VB\Sales Target Upload\Imported Extracts\*"
'if no files in the directory exit sub (err_number 53)
ErrHandler:
Exit Sub
End Sub
End Sub
Function FileOrDirExists(PathName As String) As Boolean
'function returns true if the specified directory/file exists
Dim sTemp As String
'Ignore errors to allow for error evaluation
On Error Resume Next
sTemp = GetAttr(PathName)
'Check if error exists (0 = exists)
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
'Resume error checking
On Error GoTo 0
End Function
-
batch file starting vbs:
@echo off
ping localhost 2 >nul
start c:\power.vbs
exit
vbs code starting powerpoint:
Dim strComputer, strProcess, strProcessID
strComputer = "."
strProcess = "wscript.exe"
Function IsProcessRunning( strComputer, strProcess )
Dim Process, strObject
IsProcessRunning = False
strObject = "winmgmts://" & strComputer
For Each Process in GetObject( strObject ).InstancesOf( "win32_process" )
If UCase( Process.name ) = UCase( strProcess ) Then
IsProcessRunning = True
strProcessID = Process.ProcessID
' Wscript.Echo "Process ID: " & strProcessID
Exit Function
End If
Next
End Function
If( IsProcessRunning( strComputer, strProcess ) = True ) Then
' Wscript.Echo "Killing " & strProcessID
' ------ SCRIPT CONFIGURATION ------
intPID = strProcessID
' ------ END CONFIGURATION ---------
' WScript.Echo "Process PID: " & intPID
set objWMIProcess = GetObject("winmgmts:\\" & strComputer & _
"\root\cimv2:Win32_Process.Handle='" & intPID & "'")
' WScript.Echo "Process name: " & objWMIProcess.Name
intRC = objWMIProcess.Terminate()
if intRC = 0 Then
powerpoint
end if
End If
sub powerpoint()
' Wscript.echo ("starting powerpoint")
Const ppAdvanceOnTime = 2
Const ppShowTypeKiosk = 3
Const ppSlideShowDone = 5
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Open("C:\march madness\MM Projection v 2.ppt")
objPresentation.Slides.Range.SlideShowTransition.AdvanceTime = 5
objPresentation.Slides.Range.SlideShowTransition.AdvanceOnTime = True
objPresentation.SlideShowSettings.AdvanceMode = ppAdvanceOnTime
objPresentation.SlideShowSettings.ShowType = ppShowTypeKiosk
objPresentation.SlideShowSettings.StartingSlide = 1
objPresentation.SlideShowSettings.EndingSlide = 2
objpresentation.slideshowsettings.loopuntilstopped = True
Set objSlideShow = objPresentation.SlideShowSettings.Run.View
Do Until objppt = SlideShowEnd
If Err <> 0 Then
Exit Do
End If
Loop
WScript.Quit
end sub
enjoy!!! ;D
-
Yikes! You certainly do get knee deep into the code. ;D If it works, don't change a thing. Perhaps you could persuade your boss to pay you by the word!
8)