paul.hartland at fsmail.net
paul.hartland at fsmail.net
Wed Mar 12 03:58:00 CST 2003
Thanks, works like a dream........But do you know a way around my next problem..... I use Shell("D:\Program Files\Microsoft Office\Office\Outlook.exe",vbMinimizedNoFocus) now although this opens Outlook, Outlook retains the focus, and my application is hidden behind it. Is there a way I can tell Outlook to open and then return the focus to my application ? Thanks in advance...... Paul Hartland From: "Mike and Doris Manning" <mikedorism at ntelos.net> Date: Tue 11/Mar/2003 16:20 GMT To: <accessd at databaseadvisors.com> Subject: RE: [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 _______________________________________________ AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com __________________________________________________________________________ Freeserve AnyTime - Go online whenever you want for just £6.99 a month for your first 3 months, that's HALF PRICE! And then it's just £13.99 a month after that. For more information visit http://www.freeserve.com/time/ or call free on 0800 970 8890