[RESOLVED] Outlook Verification

[oh_yeah456]

Hi,

I have obtained some code to check for new emails in Micorosft Outlook.

Dim olApp As Outlook.Application
   Set olApp = CreateObject("Outlook.Application")
   Dim olfolder As Outlook.MAPIFolder
   
Set olfolder = olApp.GetNamespace("MAPI").GetDefaultFolder(6)
If olfolder.UnReadItemCount > 0 Then
If olfolder.UnReadItemCount = 1 Then
lblMail = "You have " & olfolder.UnReadItemCount & " New Email"
Image2.Visible = True
Else
lblMail = "You have " & olfolder.UnReadItemCount & " New Emails"
Image2.Visible = True
End If
Else
lblMail = ""
Image2.Visible = False
End If

What I want to know is how can I make the program test to see whether Outlook is open or not becuase it is really annoying if you don't have it open and the program is attempting to check for new emails every minute and is startiing outlook automatically and slowing down your system.

Thanks

[RobDog888]

Welcome to the Forums.

Use error trapping and the GetObject/CreateObject functions.

Option Explicit
 
Private Sub Command1_Click()
    On Error GoTo MyError
    Dim oApp As Outlook.Application
    Dim oInbox As Outlook.MAPIFolder
    
    Set oApp = GetObject(, "Outlook.Application")
    If TypeName(oApp) = "Nothing" Then
        Set oApp = CreateObject("Outlook.Application")
    End If
    Set oInbox = oApp.GetNamespace("MAPI").GetDefaultFolder(6)
    '...
    Exit Sub
MyError:
    If Err.Number = 429 Then
        Resume Next
    Else
        MsgBox Err.Number & " - " & Err.Description
    End If
End Sub

[oh_yeah456]

Thanks, glad I found it.
...Unfortunatly that didn't work. It isn't really an error as the OLE starting the program to be able to access it if it isn't already open. What I need is a bit of code to check whether outlook.exe is running and if it isn't then completly skip that portion of code. If it is running however it will check the inbox for new emails. Well....at least i need something of that effect.

Thanks

[RobDog888]

This does work but since your using an OLE control object which you didnt state you should still be able to trapp the error regardless.

Post you code so i can see whats wrong.

[RobDog888]

We have code similar to Randy's but I'm sorry that I will have to delete the posts as its a copyright violation to be posting any of his code on any website or such as noted in his copyright code comments.

... , but you may not reproduce
' or publish this code on any web site,

Actually I have some code posted to duplicate network neighborhood too.


No worries though. Sometimes its not easy explaining situations or on the other side, providing help.

[oh_yeah456]

So can you help me?

[RobDog888]

Yes, if you post what you have so far.

[oh_yeah456]

Here are all the sections of code that aren't protected by copyright (apart from my own )

Option Explicit
Dim cpuint As Integer
Dim pagefileint As Integer
Dim diskint As Long
Dim diskintdev As Long
Dim toppos As Integer
Dim leftpos As Integer
 
Private Sub Form_Load()
If App.PrevInstance = True Then
End
End If
frmScreenSaver.WindowState = 2
Call PutWindowOnTop(Me)
lblHostname = "Computer Name: " & GetIPHostName() 'this checks computer settings, ip, host name
lblIpaddress = "IP Address: " & GetIPAddress() 'GetIPHostName, GetIPAddress, FindUserName (c) Randy Birch
lblUsername = "Current User: " & FindUserName
   Dim olApp As Outlook.Application 'this is the start of the outlook check for new emails code
   Set olApp = CreateObject("Outlook.Application")
   Dim olfolder As Outlook.MAPIFolder
   
Set olfolder = olApp.GetNamespace("MAPI").GetDefaultFolder(6)
If olfolder.UnReadItemCount > 0 Then
If olfolder.UnReadItemCount = 1 Then
lblMail = "You have " & olfolder.UnReadItemCount & " New Email"
Image2.Visible = True
Else
lblMail = "You have " & olfolder.UnReadItemCount & " New Emails"
Image2.Visible = True
End If
Else
lblMail = ""
Image2.Visible = False
End If
Call GetWinVersion 'this calls the copyright code to determine the windows version. Windows version code (c)Randy Birch
lblWinver = "  " & versionname & " " & versionno & " build " & buildno & " (" & servicepack & ")"
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
End 'ends screensaver on click
End Sub
 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static count As Integer
If count > 30 Then 'ends screensaver on mouse move with 30 click give or take to compensate for small movements caused by optical mice
End
Else
count = count + 1
End If
 
End Sub
 
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
End 'end on click again
End Sub
 
Private Sub Timer1_Timer()
Randomize 'timer 1 ticks every 10 seconds and moves image around screen as well as refreshing infrequent changing information such as ip address and new emails
leftpos = Int(Rnd * 13080) + 120
toppos = Int(Rnd * 9240) + 720
Image1.Left = leftpos
Image1.Top = toppos
lblHostname = "Computer Name: " & GetIPHostName()
lblIpaddress = "IP Address: " & GetIPAddress()
lblUsername = "Current User: " & FindUserName()
   Dim olApp As Outlook.Application
   Set olApp = CreateObject("Outlook.Application")
   Dim olfolder As Outlook.MAPIFolder
   
Set olfolder = olApp.GetNamespace("MAPI").GetDefaultFolder(6)
If olfolder.UnReadItemCount > 0 Then
If olfolder.UnReadItemCount = 1 Then
lblMail = "You have " & olfolder.UnReadItemCount & " New Email"
Image2.Visible = True
Else
lblMail = "You have " & olfolder.UnReadItemCount & " New Emails"
Image2.Visible = True
End If
Else
lblMail = ""
Image2.Visible = False
End If
End Sub
 
Private Sub Timer2_Timer()
cpuint = SystemMonitor1.Counters.Item(3).Value 'timer 2 ticks every second and displays up to date system information and time
pagefileint = SystemMonitor1.Counters.Item(1).Value 'unfortunatly the SystemMonitor control does not work on some computers
diskint = SystemMonitor1.Counters.Item(2).Value
lblCPU = "CPU Usage: " & cpuint & "%"
lblPagefile = "Memory Usage: " & pagefileint & " Pages/Sec"
diskintdev = diskint / 1024
lblDisk = "Hard Disk Usage: " & diskintdev & " KBytes/Sec"
lblTime = Time
lblDate = Date
End Sub

Randy Birch is my hero, without him most of the main features of this program would not work
THANKS RANDY

[RobDog888]

You shouldnt ever need to use "End" in VB programming. It is bad and can lead to orphaned resource usage, corrupted database, etc.

I'll get you started, we will add error handling and the outlook test code.


I see you have a reference to MS Outlook xx.0 Object Library so we might as well take advantage of that. So we will use Early Binding.

Option Explicit
 
Dim cpuint As Integer
Dim pagefileint As Integer
Dim diskint As Long
Dim diskintdev As Long
Dim toppos As Integer
Dim leftpos As Integer
 
Private Sub Form_Load()
    [b]On Error GoTo MyError[/b]
    If App.PrevInstance = True Then
        [b]Unload Me[/b] 'End
    End If
    frmScreenSaver.WindowState = 2
    Call PutWindowOnTop(Me)
    lblHostname = "Computer Name: " & GetIPHostName() 'this checks computer settings, ip, host name
    lblIpaddress = "IP Address: " & GetIPAddress() 'GetIPHostName, GetIPAddress, FindUserName (c) Randy Birch
    lblUsername = "Current User: " & FindUserName
    
    Dim olApp As Outlook.Application 'this is the start of the outlook check for new emails code
'   Set olApp = CreateObject("Outlook.Application")
    [b]Set olApp = GetObject(, "Outlook.Application")
    If TypeName(olApp) = "Nothing" Then
        Set olApp = New Outlook.Application 
    End If[/b]
    Dim olfolder As Outlook.MAPIFolder
   
    Set olfolder = olApp.GetNamespace("MAPI").GetDefaultFolder(6)
    If olfolder.UnReadItemCount > 0 Then
        If olfolder.UnReadItemCount = 1 Then
            lblMail = "You have " & olfolder.UnReadItemCount & " New Email"
            Image2.Visible = True
        Else
            lblMail = "You have " & olfolder.UnReadItemCount & " New Emails"
            Image2.Visible = True
        End If
    Else
        lblMail = ""
        Image2.Visible = False
    End If
    Call GetWinVersion 'this calls the copyright code to determine the windows version. Windows version code (c)Randy Birch
    lblWinver = "  " & versionname & " " & versionno & " build " & buildno & " (" & servicepack & ")"
    [b]Exit Sub
MyError:
    If Err.Number = 429 Then
        Resume Next
    Else
        MsgBox Err.Number & " - " & Err.Description
    End If[/b]
End Sub

[oh_yeah456]

Nope, still didn't stop outlook from starting automatically. It starts and then closes again almost instantly (once it has checked for new emails). It does this every time it refreshes and lets face it, outlook isn't the lightest program on system resources

Is error 429 some sort of "outlook not running" code? The program doesn't stop because of an error, it just starts outlook, checks, closes it and keeps going.

Any more ideas?

Thanks,

[RobDog888]

Well that is a different issue as I thought it was just checking if Oputlook is running or not and if its running attach to that instance and if its not running then create a new instance.?

429 is a "Cant create Object" error which applies to allot of objects.

[oh_yeah456]

OK. All I want it to do basically is detect whether OUTLOOK.EXE is running in the memory and then if not it skips the email checking code to keep the computer running efficiently. Also, if someone doesn't use outlook they may be faced with a "Set Up Email Accounts" dialouge out of nowhere and that would confuse things.

Gee, it is diffucult trying to convey VB problems over forums. Thanks for being patient

Thanks

[RobDog888]

Np, just change the If block of code that is bold to this...

If TypeName(olApp) = "Nothing" Then
    'Set olApp = New Outlook.Application 
    MsgBox "Outlook not running", vbOkOnly + vbExclamation
    Exit Sub
End If

[oh_yeah456]

Oh thats good. That works perfectly!
Thanks very much
You're awsome

[RobDog888]

Your Welcome.

Ps, dont forget to Resolve your thread.