I'm fairly new to VB Scripting, i have written a vb script that will check to see if out look is open and it is not it will open it. i want to a some code in that script that will allow it to run every 5 minutes un till the computer is shut off.
Can you help?
You do not need to use scripting to determine if Outlook is open or not. By using a reference to MS Office objects you can load outlook, see if new mail arrived , minimize/maximize outlook etc. I have used the following code which works fine on 2003, 2007. I have not tested earlier versions though -
Add a module to your app.
Public Function UnreadMessagesInInbox() As Long
'*****************************************
'RETURNS: Unread messages in the inbox on the local system,
' or 0 if an error occurs
'REQUIRES: Outlook and Outlook Object Library
' Application must have reference to
' Outlook Object Library
'NOTES: Same technique can be used to
' Retrieve unread messages in other
' Folders. Just pass a diferent
' parameter to GetDefaultFolder, or
' Identify the folder by name using
' The MAPIFolder's Folders collection.
' Refer to documentation or other examples
' on FreeVBCode.com for more detail
'******************************************
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.MAPIFolder
On Error GoTo ErrorHandler
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
UnreadMessagesInInbox = oFldr.UnReadItemCount
ErrorHandler:
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
End Functionon your form, add a timer -
Private Sub tmrMail_Timer()
Dim MailOpen As Outlook.Application
On Error Resume Next
Set MailOpen = GetObject(, "Outlook.Application")
If MailOpen Is Nothing Then
'Your code here if outlook is closed
Else
Call UnreadMessagesInInbox 'Outlook is already open, timer checks for new mail
lblOpenMail.Caption = UnreadMessagesInInbox & vbCrLf & "New"
lblOpenMail.ForeColor = &H404040
End If
Exit Sub
Else
If MailOpen Is Nothing Then
Err.Clear
Else
Call UnreadMessagesInInbox
lblOpenMail.Caption = UnreadMessagesInInbox & vbCrLf & "New"
lblOpenMail.ForeColor = &H404040
lblOpenMail.Visible = True
End If
End If
End SubWhen you click on the label, outlook will show -
Private Sub lblOpenMail_Click()
Dim MaximiseOutlook As Outlook.Application
On Error Resume Next
Set MaximiseOutlook = GetObject(, "Outlook.Application")
MaximiseOutlook.ActiveExplorer.Activate
End SubYou do not need to use scripting to determine if Outlook is open or not. By using a reference to MS Office objects you can load outlook, see if new mail arrived , minimize/maximize outlook etc. I have used the following code which works fine on 2003, 2007. I have not tested earlier versions though -
Add a module to your app.
Public Function UnreadMessagesInInbox() As Long
'*****************************************
'RETURNS: Unread messages in the inbox on the local system,
' or 0 if an error occurs
'REQUIRES: Outlook and Outlook Object Library
' Application must have reference to
' Outlook Object Library
'NOTES: Same technique can be used to
' Retrieve unread messages in other
' Folders. Just pass a diferent
' parameter to GetDefaultFolder, or
' Identify the folder by name using
' The MAPIFolder's Folders collection.
' Refer to documentation or other examples
' on FreeVBCode.com for more detail
'******************************************
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As Outlook.MAPIFolder
On Error GoTo ErrorHandler
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
UnreadMessagesInInbox = oFldr.UnReadItemCount
ErrorHandler:
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
End Functionon your form, add a timer -
Private Sub tmrMail_Timer()
Dim MailOpen As Outlook.Application
On Error Resume Next
Set MailOpen = GetObject(, "Outlook.Application")
If MailOpen Is Nothing Then
'Your code here if outlook is closed
Else
Call UnreadMessagesInInbox 'Outlook is already open, timer checks for new mail
lblOpenMail.Caption = UnreadMessagesInInbox & vbCrLf & "New"
lblOpenMail.ForeColor = &H404040
End If
Exit Sub
Else
If MailOpen Is Nothing Then
Err.Clear
Else
Call UnreadMessagesInInbox
lblOpenMail.Caption = UnreadMessagesInInbox & vbCrLf & "New"
lblOpenMail.ForeColor = &H404040
lblOpenMail.Visible = True
End If
End If
End SubWhen you click on the label, outlook will show -
Private Sub lblOpenMail_Click()
Dim MaximiseOutlook As Outlook.Application
On Error Resume Next
Set MaximiseOutlook = GetObject(, "Outlook.Application")
MaximiseOutlook.ActiveExplorer.Activate
End Subhope this helps
thank you but, the problem I have is the user closes Outlook and I need Outlook to remain open. they don't minimize Outlook, it's closed. The VB script is in the startup but, I need it to run every 5 minutes to insure Outlook stays open and if it is closed by the user it will open by it's self. Some of my users have a habit of shutting Outlook down after they read their email in the morning then they will open it in the afternoon. Here is the script I wrote to open and chck if it is open.
Dim AllProcess
Dim Process
Dim strFoundProcess
strFoundProcess = False
Set AllProcess = getobject("winmgmts:") 'create object
For Each Process In AllProcess.InstancesOf("Win32_process") 'Get all the processes running in your PC
If (Instr (Ucase(Process.Name),"OUTLOOK.EXE") = 1) Then 'Made all uppercase to remove ambiguity. Replace Outlook.EXE with your application name in CAPS.
'You can replace this with Reporter.ReportEvent
strFoundProcess = True
Exit for
End If
Next
If strFoundProcess = False Then
Set oShell = CreateObject("WScript.Shell")
oShell.Run "outlook.exe", 1, False
'You can replace this with Reporter.ReportEvent
End If
Set AllProcess = nothing
I think that you might slow down your application by using the above, because you will be running a process check every 5 minutes. I have changed the code a bit to the following, where it only checks whether outlook is closed or not, if it is, it will open outlook again and minimise it to the taskbar. Let me know if this helped solving your problem faster -
Option Explicit
'Declarations first ---
'Ensure that MS Outlook Object Library is referenced
Dim sTopic As String
Dim sFile As String
Dim sParams As String
Dim sDirectory As String
Private Sub RunShellExecute(sTopic As String, _
sFile As Variant, _
sParams As Variant, _
sDirectory As Variant, _
nShowCmd As Long)
Dim hWndDesk As Long
Dim success As Long
'the desktop will be the
'default for error messages
hWndDesk = GetDesktopWindow()
'execute the passed operation
success = ShellExecute(hWndDesk, sTopic, sFile, sParams, sDirectory, nShowCmd)
End Sub
Private Sub Timer1_Timer()
Dim MailOpen As Outlook.Application
On Error Resume Next
Set MailOpen = GetObject(, "Outlook.Application")
If MailOpen Is Nothing Then 'Outlook has been closed
Err.Clear
sTopic = "Open"
sFile = vbNullString
sParams = vbNullString
sDirectory = vbNullString
sFile = "outlook.exe"
Call RunShellExecute(sTopic, sFile, sParams, sDirectory, SW_SHOWMINIMIZED)
Else
MailOpen.ActiveExplorer.Activate
End If
Timer1.Enabled = False
End SubIn a module add the following -
Option Explicit
Public Const SW_SHOWNORMAL As Long = 1
Public Const SW_SHOWMAXIMIZED As Long = 3
Public Const SW_SHOWDEFAULT As Long = 10
Public Const SW_SHOWMINIMIZED As Long = 2
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongAnd this is it. You will notice that the Timer has been disabled at the end. Change it's enable properties to what suits you the best.
thank you i will give it a try.
No problem. Good luck.
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.