none
Erreur lors de la fermeture d'un fichier accdr RRS feed

  • Question

  • Bonjour,

    Lorsque je quitte ma base de données, j'obtiens cette erreur:

    Du menu principal, un usager presse le bouton Fermer, un message lui demande s'il est certain, s'il clique OUI, voici le code:

    Private Sub OUI_Click()
    fCloseApp ("#32770")
    fCloseApp ("OMain")
    fCloseApp ("CabinetWClass"
    DoCmd.CloseDatabase
    DoCmd.Quit
    
    End Sub
    
    fCloseApp function code:
    
    Function fCloseApp(lpClassName As String) As Boolean
    'Usage Examples:
    '   To close Calculator:
    '       ?fCloseApp("SciCalc")
    '
    Dim lngRet As Long, Hwnd As Long, pID As Long
    
        Hwnd = apiFindWindow(lpClassName, vbNullString)
        If (Hwnd) Then
            lngRet = apiPostMessage(Hwnd, WM_CLOSE, 0, ByVal 0&)
            Call apiGetWindowThreadProcessId(Hwnd, pID)
            Call apiWaitForSingleObject(pID, INFINITE)
            fCloseApp = Not (apiIsWindow(Hwnd) = 0)
        End If
    End Function
    '************* Code End ***************
    

    la function fEnumWindows me donne tout ce qui est ouvert, voyez plutôt:

    J'aimerais bien éliminer cette erreur lorsque la base de données est fermée chez un client, tout fonctionne correctement, mais un message comme celui-la ne donne pas confiance.

    Merci

    Claude du Québec


    Claude Larocque

    lundi 9 avril 2012 20:27

Réponses

  • Humm, sans tenter de tuer les process externes, est-ce que

    Private Sub OUI_Click()
        Application.Quit 2
    End Sub
    

    provoque cette erreur ?


    Argy

    mercredi 11 avril 2012 12:01
    Modérateur
  • Bonjour Argy,

    Voici le code pour fEnumWindows tel que tu as demandé, pour ce que je veux faire, simplement fermer le programme printFile.exe qui imprime les factures selon les lois et fermer la base de données, tout semble fonctionnner parfaitement, y-a-t'il quelque chose qui t'inquiète, merci!

    '************** Code Start ***************
    ' This code was originally written by Dev Ashish.
    ' It is not to be altered or distributed,
    ' except as part of an application.
    ' You are free to use it in any application,
    ' provided the copyright notice is left unchanged.
    '
    ' Code Courtesy of
    ' Dev Ashish
    '
    Private Declare PtrSafe Function apiGetClassName Lib "User32" Alias _
                    "GetClassNameA" (ByVal Hwnd As Long, _
                    ByVal lpClassName As String, _
                    ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function apiGetDesktopWindow Lib "User32" Alias _
                    "GetDesktopWindow" () As Long
    Private Declare PtrSafe Function apiGetWindow Lib "User32" Alias _
                    "GetWindow" (ByVal Hwnd As Long, _
                    ByVal wCmd As Long) As Long
    Private Declare PtrSafe Function apiGetWindowLong Lib "User32" Alias _
                    "GetWindowLongA" (ByVal Hwnd As Long, ByVal _
                    nIndex As Long) As Long
    Private Declare PtrSafe Function apiGetWindowText Lib "User32" Alias _
                    "GetWindowTextA" (ByVal Hwnd As Long, ByVal _
                    lpString As String, ByVal aint As Long) As Long
    Private Const mcGWCHILD = 5
    Private Const mcGWHWNDNEXT = 2
    Private Const mcGWLSTYLE = (-16)
    Private Const mcWSVISIBLE = &H10000000
    Private Const mconMAXLEN = 255
    
    Function fEnumWindows()
    Dim lngx As Long, lngLen As Long
    Dim lngStyle As Long, strCaption As String
        
        lngx = apiGetDesktopWindow()
        'Return the first child to Desktop
        lngx = apiGetWindow(lngx, mcGWCHILD)
        
        Do While Not lngx = 0
            strCaption = fGetCaption(lngx)
            If Len(strCaption) > 0 Then
                lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
                'enum visible windows only
                If lngStyle And mcWSVISIBLE Then
                    Debug.Print "Class = " & fGetClassName(lngx),
                    Debug.Print "Caption = " & fGetCaption(lngx)
                End If
            End If
            lngx = apiGetWindow(lngx, mcGWHWNDNEXT)
        Loop
    End Function
    Private Function fGetClassName(Hwnd As Long) As String
        Dim strBuffer As String
        Dim intCount As Integer
       
        strBuffer = String$(mconMAXLEN - 1, 0)
        intCount = apiGetClassName(Hwnd, strBuffer, mconMAXLEN)
        If intCount > 0 Then
            fGetClassName = Left$(strBuffer, intCount)
        End If
    End Function
    
    Private Function fGetCaption(Hwnd As Long) As String
        Dim strBuffer As String
        Dim intCount As Integer
    
        strBuffer = String$(mconMAXLEN - 1, 0)
        intCount = apiGetWindowText(Hwnd, strBuffer, mconMAXLEN)
        If intCount > 0 Then
            fGetCaption = Left$(strBuffer, intCount)
        End If
    End Function
    '************** Code End ***************

    D'autres questions, n'hésite surtout pas

    Claude


    Claude Larocque

    jeudi 12 avril 2012 17:15

Toutes les réponses

  • Bonjour,

    L'usage des API doit être fait avec une grande précaution... d'autant plus que votre fonction est incomplète et tenter de "killer" "OMain" alors qu'il est en court d'exécution vous expose à ce type d'erreur...

    En lisant votre code, j'ai le sentimentque vous savez à peu près  où vous voulez aller mais que vous n'avez pas su l'écrire.

    Pour quitter votre application et fermer d'autres programmes, il faut d'abord fermer ces programmes (s'ils existent) et ensuite quitter l'application...

    Expliquez ce que vous voulez faire et je pourrais vous aider...


    Argy

    mercredi 11 avril 2012 07:38
    Modérateur
  • Bonjour Argy,

    Lorsque j'installe ma base de données chez un client, je change l'extension pour accdr. Plus souvent qu'autrement, le client n'a pas Microsoft Access 2010 alors j'installe le runtime 2010 x64 sur les ordinateurs qui sont 64 bits.

    Lorsque la base de données se ferme, elle produit cette erreur. Cette erreur se produit même si je tente de "Killer" seulement #32770 qui est le programme printfile.exe que j'utilise pour envoyer les données en format texte en code xml. (Nécessaire avec la loi sur le module d'enregistrement des ventes du gouvernement du Québec)

    Si j'utilise accdb, aucun problème.

    Merci

    Ce que j'essai de faire c'est de fermer la base de données tout simplement, sans erreur.

    Claude


    Claude Larocque


    mercredi 11 avril 2012 10:03
  • Humm, sans tenter de tuer les process externes, est-ce que

    Private Sub OUI_Click()
        Application.Quit 2
    End Sub
    

    provoque cette erreur ?


    Argy

    mercredi 11 avril 2012 12:01
    Modérateur
  • Merci Argy,

    Voici le code que j'ai placé sur le bouton OUI:

    Private Sub OUI_Click()
    fCloseApp ("#32770")
    Application.Quit 2
    End Sub

    Je dois fermer le # 32770, mais avec ta commande, tout se passe normalement. Super!

    Merci encore pour prendre le temps d'aider


    Claude Larocque

    jeudi 12 avril 2012 04:16
  • Le #32770 est un identifiant de classe des MsgBox() : Comment avez-vous trappé cette valeur et ?

    Que voulez-vous faire exactement dans l'ordre chronologique ?

    Par ailleurs, pouvez-vous montrer comme vous avez codé la fonction fEnumWindows() ?


    Argy

    jeudi 12 avril 2012 07:39
    Modérateur
  • Bonjour Argy,

    Voici le code pour fEnumWindows tel que tu as demandé, pour ce que je veux faire, simplement fermer le programme printFile.exe qui imprime les factures selon les lois et fermer la base de données, tout semble fonctionnner parfaitement, y-a-t'il quelque chose qui t'inquiète, merci!

    '************** Code Start ***************
    ' This code was originally written by Dev Ashish.
    ' It is not to be altered or distributed,
    ' except as part of an application.
    ' You are free to use it in any application,
    ' provided the copyright notice is left unchanged.
    '
    ' Code Courtesy of
    ' Dev Ashish
    '
    Private Declare PtrSafe Function apiGetClassName Lib "User32" Alias _
                    "GetClassNameA" (ByVal Hwnd As Long, _
                    ByVal lpClassName As String, _
                    ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function apiGetDesktopWindow Lib "User32" Alias _
                    "GetDesktopWindow" () As Long
    Private Declare PtrSafe Function apiGetWindow Lib "User32" Alias _
                    "GetWindow" (ByVal Hwnd As Long, _
                    ByVal wCmd As Long) As Long
    Private Declare PtrSafe Function apiGetWindowLong Lib "User32" Alias _
                    "GetWindowLongA" (ByVal Hwnd As Long, ByVal _
                    nIndex As Long) As Long
    Private Declare PtrSafe Function apiGetWindowText Lib "User32" Alias _
                    "GetWindowTextA" (ByVal Hwnd As Long, ByVal _
                    lpString As String, ByVal aint As Long) As Long
    Private Const mcGWCHILD = 5
    Private Const mcGWHWNDNEXT = 2
    Private Const mcGWLSTYLE = (-16)
    Private Const mcWSVISIBLE = &H10000000
    Private Const mconMAXLEN = 255
    
    Function fEnumWindows()
    Dim lngx As Long, lngLen As Long
    Dim lngStyle As Long, strCaption As String
        
        lngx = apiGetDesktopWindow()
        'Return the first child to Desktop
        lngx = apiGetWindow(lngx, mcGWCHILD)
        
        Do While Not lngx = 0
            strCaption = fGetCaption(lngx)
            If Len(strCaption) > 0 Then
                lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
                'enum visible windows only
                If lngStyle And mcWSVISIBLE Then
                    Debug.Print "Class = " & fGetClassName(lngx),
                    Debug.Print "Caption = " & fGetCaption(lngx)
                End If
            End If
            lngx = apiGetWindow(lngx, mcGWHWNDNEXT)
        Loop
    End Function
    Private Function fGetClassName(Hwnd As Long) As String
        Dim strBuffer As String
        Dim intCount As Integer
       
        strBuffer = String$(mconMAXLEN - 1, 0)
        intCount = apiGetClassName(Hwnd, strBuffer, mconMAXLEN)
        If intCount > 0 Then
            fGetClassName = Left$(strBuffer, intCount)
        End If
    End Function
    
    Private Function fGetCaption(Hwnd As Long) As String
        Dim strBuffer As String
        Dim intCount As Integer
    
        strBuffer = String$(mconMAXLEN - 1, 0)
        intCount = apiGetWindowText(Hwnd, strBuffer, mconMAXLEN)
        If intCount > 0 Then
            fGetCaption = Left$(strBuffer, intCount)
        End If
    End Function
    '************** Code End ***************

    D'autres questions, n'hésite surtout pas

    Claude


    Claude Larocque

    jeudi 12 avril 2012 17:15
  • « y-a-t'il quelque chose qui t'inquiète »

    Non, pas particulièrement.

    Je voulais juste m'assurer que votre problème était résolu et ce n'était pas significatif dans votre répons ; apparement, c'est le cas.


    Argy

    vendredi 13 avril 2012 06:37
    Modérateur