vba excel access, attente entre les ordres

Question

Bonjour à tous,

Une macro excel sollicite plusieurs fois une base access (écriture et récupérations de données, lancement de macro access avec shell, récupération de résultat de requêtes access dans des TCD de plusieurs classeurs ...).
La base access a besoin d'etre compilée après chaque sollicitation (pb taille et memoire) ; à défaut tout devient instable ou se bloque ; access reste ouvert !
 
Tout fonctionne très bien en mode manuel, j'attends qu'access se ferme et se compile. (Environnement excel/access 2000 sur windows NT). Les temps d'exécution sont très variables tenant tant à l'application qu'au niveau d'utilisation du serveur...
 
Une routine d'attente de fin d'exécution d'access entre chaque sollicitation d'excel devrait permettre d'automatiser les opérations.
Qui aurait une solution ou une piste ?
 
Cordiales salutations à tous
ls8ls8

cs_DARKSIDIOUS · Answer

Salut,

Est-ce que tu n'as qu'une seule instance d'access d'ouverte à la fois ?

Une bonne veuille boucle while (avec un sleep à l'intérieur histoire de ne pas occuper 100% du CPU) qui teste chaque seconde si le processus d'access est lancé ou pas devrait faire l'affaire.
______________________________________

AVANT de poster votre message, veuillez lire, comprendre, et appliquer notre réglement

c148270 · Answer

Bonjour
Voici un exemple 

Private Declare Function apiGetShortPathName Lib "Kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'-------------------------------
' ce module permet le lancement du traitement dans la base
' et suspend le déroulement des autres modules tant que le traitement n'est pas fini
'-------------------------------
Private Type STARTUPINFO
      cb As Long
      lpReserved As String
      lpDesktop As String
      lpTitle As String
      dwX As Long
      dwY As Long
      dwXSize As Long
      dwYSize As Long
      dwXCountChars As Long
      dwYCountChars As Long
      dwFillAttribute As Long
      dwFlags As Long
      wShowWindow As Integer
      cbReserved2 As Integer
      lpReserved2 As Long
      hStdInput As Long
      hStdOutput As Long
      hStdError As Long
   End Type

   Private Type PROCESS_INFORMATION
      hProcess As Long
      hThread As Long
      dwProcessID As Long
      dwThreadID As Long
   End Type

   Private Declare Function WaitForSingleObject Lib "Kernel32" (ByVal _
      hHandle As Long, ByVal dwMilliseconds As Long) As Long

   Private Declare Function CreateProcessA Lib "Kernel32" (ByVal _
      lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
      lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
      ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
      ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
      lpStartupInfo As STARTUPINFO, lpProcessInformation As _
      PROCESS_INFORMATION) As Long

   Private Declare Function CloseHandle Lib "Kernel32" _
      (ByVal hObject As Long) As Long

   Private Declare Function GetExitCodeProcess Lib "Kernel32" _
      (ByVal hProcess As Long, lpExitCode As Long) As Long
   Private Const STARTF_USESHOWWINDOW = &H1
   Private Const NORMAL_PRIORITY_CLASS = &H20&
   Private Const INFINITE = -1&
Function chargement()

'------------------------------------
' emplacement de la base. Permet à l'utilisateur de la mettre où il veut
'----------------------------------
retval = Application.GetOpenFilename("Microsoft Access(*.mde),*.mde)", , "Emplacement de la base de données")
    If retval = False Then
        retval3 = MsgBox("Exécution annulée", , "Extraction")
        Exit Function
    End If
    Dim strShortFilename As String
    Dim strReturnedShortFilename As String
    strShortFilename = String$(1000, " ")
'------------------
' recherche du nom court pour le SHELL
'-------------------------
    apiGetShortPathName retval, strShortFilename, 1000
    retval = Left$(strShortFilename, Len(Trim$(strShortFilename)) - 1)
'-------------------------
' lancement du traitement de la base
'----------------------------------
    lancement = "msaccess.exe " & retval
Retval1 = ExecCmd(lancement)
''''' les instructions placées ici ne s'exécuteront que l'orque access sera fermeé
End Function

Public Function ExecCmd(lancement)
      Dim proc As PROCESS_INFORMATION
      Dim start As STARTUPINFO
'------------------------
      ' Initialise la structure STARTUPINFO :
'-------------------------
      start.cb = Len(start)
    start.dwFlags = STARTF_USESHOWWINDOW
    start.wShowWindow = 1
'-----------------------
      ' Démarre l'application access :
'-------------------------
      ret& = CreateProcessA(vbNullString, lancement, 0&, 0&, 1&, _
         NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
'----------------------------
      ' Attend la fin de l'application access :
'---------------------------------
         ret& = WaitForSingleObject(proc.hProcess, INFINITE)
         Call GetExitCodeProcess(proc.hProcess, ret&)
         Call CloseHandle(proc.hThread)
         Call CloseHandle(proc.hProcess)
         ExecCmd = ret&
   End Function


Bonne journée

ls8ls8 · Answer

Bonsoir,

Je viens de lire vos messages et mettrai en application dès demain.
Merci
Bien cordialement

ls8ls8 · Answer

Bonjour,
je n'ai pas réussi à me dépatouiller avec le 2eme code qui doit présenter l'avantage d'éviter le blocage mémoire.

En attendant, j'ai commis le code VBA excel ci_dessous qui boucle tant que le fichier .ldb d'access existe dans le répertoire où se situe la base.
Ca fonctionne mais je pense que ce n'est pas très élégant. 

Merci pour votre contribution
Cordiales salutations
ls8ls8


Function ExistenceFichier(sFichier As String) As Boolean
  ExistenceFichier = Dir(sFichier) <> ""
  
End Function
'-----
Sub attente2()
While ExistenceFichier("D:
om_du_repertoire
om_de_ma base.ldb") = True
Application.Wait Now + TimeValue("0:00:10")
Wend
'MsgBox ("Ca continue !") message utile au débogage
Sheets("MENU").Select
Range("a1").Select
End Sub

c148270 · Answer

Bonjour
De mon point de vue l'élégance passe après l'efficacité.

Attention cependant. Le ldb existe jusqu'à access 2003 après (2007) il devient laccdb.

Bonne journée

Vba excel access, attente entre les ordres

5 réponses

Votre réponse

Discussions similaires