outlook vba quesiton...

[blastman]

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.

[Sidewinder]

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.

 

It wasn't clear what happens if no new slideshow arrives. Does PowerPoint shutdown or continue to loop with the old data?

[blastman]

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.

 

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

[Sidewinder]

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)


Save Outlook Attachment:

Code: [Select]

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:

Code: [Select]

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 

[blastman]

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.

[Sidewinder]

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. 

In my previous post I recommended VBScript, but further research shows that VBScript  might not be a good solution.

[blastman]

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!!)

[Sidewinder]

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?

 

[blastman]

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!! 

(I'll post the code if your intrested. let me know)

[Sidewinder]

I'm glad everything is working.

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 

[blastman]

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.

Code: [Select]

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.

[Sidewinder]

Code: [Select]

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.

 

KISS is not just another four letter word.

[blastman]

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!!

[SEBNN]

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.

[blastman]

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

[SEBNN]

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.

[Sidewinder]

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.

[blastman]

Congrats! You'll be a whiz by the time March Madness 2009 rolls around.

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

[SEBNN]

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.

[blastman]

outlook code (main page)

Code: [Select]

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



[blastman]

outlook modual code;

Code: [Select]

'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

[blastman]

batch file starting vbs:

Code: [Select]

@echo off

ping localhost 2 >nul

start c:\power.vbs

exit


vbs code starting powerpoint:

Code: [Select]

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!!! 

[Sidewinder]

Yikes! You certainly do get knee deep into the code.   If it works, don't change a thing. Perhaps you could persuade your boss to pay you by the word!