Close Access from VB6...

[bluenoser337]

I need the code for closing MSACCESS.EXE (Access 2000) from a button click, for example, within my VB application. Thanks!!

 

[SleepDepD]

Try this out. It uses a callback function and the name of Microsoft Access's main window class name and title: "OMain" and "Microsoft Access" respectively.

'!!! PLACE THE FOLLOWING IN A FORM
Option Explicit
'

Private Sub cmdCloseMSAccessWindows_Click()
  '-- Run a loop closing all "Microsoft Access" windows
  Do Until CloseAccess = False
  Loop
End Sub


'!!! PLACE THE FOLLOWING IN A MODULE
Option Explicit

Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_CLOSE = &H10

Private mlngHWNDAccess    As Long
'

Public Function CloseAccess() As Boolean
  Dim lngHWND             As Long
  
  '-- Get the HWND of a Microsoft Access window (if exists) and close it
  lngHWND = GetAccessHWND
  If lngHWND > 0 Then
    Call SendMessage(lngHWND, WM_CLOSE, 0, 0)
    
    '-- If window was close, return True so another close attempt will be made
    CloseAccess = True
  End If
End Function

Private Function GetAccessHWND() As Long
  Dim lngSuccess          As Long
  
  '-- Enumerate though windows using a callback function
  lngSuccess = EnumWindows(AddressOf FindAccessWindow, 58&)
  GetAccessHWND = mlngHWNDAccess
  
  '-- Reset modular variable
  mlngHWNDAccess = 0
End Function

Public Function FindAccessWindow(ByVal lngHWND As Long, ByVal lParam As Long) As Long
  Dim strReturn           As String
  Dim lngReturn           As Long
  
  If lParam = 58 Then '-- Enumerate windows
    '-- Get this window's class name
    strReturn = Space$(255)
    lngReturn = GetClassName(lngHWND, strReturn, Len(strReturn))
    strReturn = Left$(strReturn, lngReturn)
    
    '-- Check if it is "OMain", the class name of Access's window
    If StrComp(strReturn, "OMain") = 0 Then
      '-- Get this window's text
      strReturn = Space$(255)
      lngReturn = GetWindowText(lngHWND, strReturn, Len(strReturn))
      strReturn = Left$(strReturn, lngReturn)
      
      '-- Check if it starts with "Microsoft Access"
      If StrComp(Left$(strReturn, 16), "Microsoft Access") = 0 Then
        '-- Set modular variable; exit function without returning "1" (this will end enumeration)
        mlngHWNDAccess = lngHWND
        GoTo Exit_Proc
      End If
    End If
    
    FindAccessWindow = 1
  End If
  
Exit_Proc:
  Exit Function
End Function

 

[bluenoser337]

SleepDepD...Thanks! OMG, I was thinking this might be 1 or 2 lines. Is all this necessary...really?

 

[SleepDepD]

It's how I would do it. There might be simpler ways, but I can't think of anything. One thing: you don't have to do the looping in "cmdCloseMSAccessWindows_Click". You could just call "CloseAccess" once. But because the title of an instance of Access is "Microsoft Access - name of open database", you need to do some kind of enumerating through open windows to get the HWND of the Access window.

I wouldn't be too worried about the length of code. It's only one line to call the initial function; if you wanted you could put everything else in it's own module, encapsulated away from everything else in your application.

 

[CubeE101]

You could shorten it a bit...

Form Code:

Option Explicit
Private Sub cmdCloseMSAccessWindows_Click()
  While CloseAccess
  Wend
End Sub

Module Code:

Option Explicit
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private mlngHWNDAccess As Long

Public Function CloseAccess() As Boolean
  EnumWindows(AddressOf FindAccessWindow, 0)
  If mlngHWNDAccess Then SendMessage mlngHWNDAccess, &H10, 0, 0: CloseAccess = True
End Function

Public Function FindAccessWindow(ByVal lngHWND As Long, ByVal lParam As Long) As Long
  Dim strReturn As String, lngReturn As Long
  strReturn = Space$(255)
  If Left$(strReturn, GetClassName(lngHWND, strReturn, Len(strReturn))) = "OMain" Then
    strReturn = Space$(255)
    GetWindowText lngHWND, strReturn, Len(strReturn)
    If Left$(strReturn, 16) = "Microsoft Access" Then mlngHWNDAccess = lngHWND Else FindAccessWindow = -1
  End If
End Function

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[strongm]

Here's the simple version:

[blue]Option Explicit

Private Sub Command1_Click()
    Dim myAccess As Object
    Dim AllClosed As Boolean
    
    ' Closes all running instances of MS Access
    Do Until AllClosed
        On Error Resume Next
            Set myAccess = GetObject(, "Access.Application")
            If Err = 0 Then
                myAccess.Quit
            Else
                AllClosed = True
            End If
        On Error GoTo 0
    Loop
End Sub
[/blue]

 

[CubeE101]

I was wondering why no one posted that yet...

I don't have access so I haven't messed with the API... Should have guessed it would be just like Excel/Word

I just happened to run accross a EnumWindows Problem, and figured I'd update the code on this thread ;-)

For that matter you could just do this too...

Option Explicit

Private Sub Command1_Click()
  Dim AllClosed As Boolean
  On Error Resume Next
    Do Until AllClosed
      GetObject(, "Access.Application").Quit
      If Err Then AllClosed = True
    Loop
  On Error GoTo 0
End Sub

GetObject(, "Access.Application").Quit

can also be:
GetObject(, "Word.Application").Quit
GetObject(, "Excel.Application").Quit

and probably several others... (especially the Office Apps)

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[bluenoser337]

Thanks! That looks more like what I expected. Can wait to try it next week.

 

[strongm]

Gosh, Josh, if you want to play 'cut down the code':

[blue]Private Sub Command1_Click()
    On Error Resume Next
        Do
            GetObject(, "Access.Application").Quit
        Loop Until Err
    On Error GoTo 0
End Sub
[/blue]

Your go...

 

[CubeE101]

Oh yeah?

Private Sub Command1_Click()
  On Error GoTo 1
  GetObject(, "Access.Application").Quit
  Command1_Click
1 End Sub

Though, you probably don't need more than:

Private Sub Command1_Click()
  On Error GoTo 1
  GetObject(, "Access.Application").Quit
1 End Sub

;-)

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[strongm]

Ah, but unfortunately you've missed the point of the loop, which is to ensure that all instances of Access is closed down if more than one is open. Your new version merely closes (an essentially random) one...

 

[CubeE101]

too bad this isn't .NET, you could just use a...
such as...
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Try : GetObject(, "Word.Application").Quit() : Catch : End Try
End Sub

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[CubeE101]

>> Ah, but unfortunately you've missed the point of the loop

Nah...

Private Sub Command1_Click()
  On Error GoTo 1
  GetObject(, "Access.Application").Quit
  [b]Command1_Click[/b]
1 End Sub

Recursive Functions do loop ;-)

If there are no apps to close it will jump to 1 (End Sub) and back down the line of functions...

Like I said, I don't have Access, so I tested it on word...

Opened 3 instances of word and 1 loop is all it went through, so the second part (without the recurse) worked as well...

hence the probably for the second part...

I can't test it... Give it a try and let me know ;-)

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[strongm]

It was the second part I tested. No point looking at interim code ;-)

 

[CubeE101]

Sooo...

do you agree this:

Private Sub Command1_Click()
  On Error GoTo 1
  GetObject(, "Access.Application").Quit
  Command1_Click
1 End Sub

Is the shortest, functional, version?

Or do you have yet another trick up your sleeve? ;-)

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[strongm]

Another trick? No, not me. I'm still recovering from Xmas...

 

[CubeE101]

>> I'm still recovering from Xmas...

LOL... me too... but I got Bronchitis and was sick all through Xmas... I'm still trying to get over that crap... It better clear up BEFORE tomorrow night ;-)

hope everyone has a Happy New Year

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.