[AccessD] Opening Outlook if closed code not working

I ran into the same problem.  Here is the code from my IsOutlookOpen module:

Option Compare Database
Option Explicit

Private bolOutlook As Boolean

Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
    (ByVal hwnd As Long, ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long

Declare Function GetWindowTextLength Lib "user32" _
    Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, _
    ByVal CCh As Long) As Long

Declare Function EnumWindows Lib "user32" _
    (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Function IsOutlookOpen() As Boolean
' This is the entry point that makes it happen
    EnumWindows AddressOf EnumWindowProc, 0
    IsOutlookOpen = bolOutlook
End Function

Public Function EnumWindowProc(ByVal hwnd As Long, _
    ByVal lParam As Long) As Long

    'Do stuff here with hwnd
    Dim sClass As String
    Dim sIDType As String
    Dim sTitle As String
    
    'Get the title to the window
    sTitle = GetWindowIdentification(hwnd, sIDType, sClass)
    
    'Check to see if it is an Outlook window
    If InStr(1, sTitle, "Microsoft Outlook") > 0 Then
        bolOutlook = True
        EnumWindowProc = False
    Else
        bolOutlook = False
        EnumWindowProc = True
    End If
End Function

Private Function GetWindowIdentification(ByVal hwnd As Long, _
  sIDType As String, sClass As String) As String

    Dim nSize As Long
    Dim sTitle As String
    
    'get the size of the string required
    'to hold the window title
    nSize = GetWindowTextLength(hwnd)
    
    'if the return is 0, there is no title
    If nSize > 0 Then
        sTitle = Space$(nSize + 1)
        Call GetWindowText(hwnd, sTitle, nSize + 1)
        sIDType = "title"
        sClass = Space$(64)
        Call GetClassName(hwnd, sClass, 64)
    Else
        'no title, so get the class name instead
        sTitle = Space$(64)
        Call GetClassName(hwnd, sTitle, 64)
        sClass = sTitle
        sIDType = "class"
    End If
    
    GetWindowIdentification = TrimNull(sTitle)
End Function

Private Function TrimNull(StartStr As String) As String
    Dim Pos As Integer
    
    Pos = InStr(StartStr, Chr$(0))
    If Pos Then
        TrimNull = LEFT(StartStr, Pos - 1)
        Exit Function
    End If
    
    'if this far, there was
    'no Chr$(0), so return the string
    TrimNull = StartStr
End Function

Doris Manning
Database Administrator
Hargrove Inc.
www.hargroveinc.com


-----Original Message-----
From: accessd-admin at databaseadvisors.com
[mailto:accessd-admin at databaseadvisors.com] On Behalf Of
paul.hartland at fsmail.net
Sent: Tuesday, March 11, 2003 09:22 AM
To: accessd at databaseadvisors.com; dba-vb at databaseadvisors.com
Subject: [AccessD] Opening Outlook if closed code not working


To all,

Can anyone see why the following code (VB6) would open Outlook even if it is
already open, I want a module that when I run my application, it checks to
see if Outlook is open if not open it......

Function OpenOutlook()
    Dim objOut As Object
    On Error Resume Next
    
    Set objOut = GetObject("Outlook.Application")
    
    If (Err <> 0) Then
        Dim strOpenOutlook
        strOpenOutlook = Shell("D:\PROGRAM FILES\MICROSOFT
OFFICE\OFFICE\OUTLOOK.EXE", vbMinimizedNoFocus)
    End If
End Function

Thanks in advance.

Paul