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