IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Code d'accès au snapshot du système sous 64 bit [XL-2010]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Homme Profil pro
    Architecte technique
    Inscrit en
    Septembre 2011
    Messages
    48
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Maroc

    Informations professionnelles :
    Activité : Architecte technique
    Secteur : Bâtiment

    Informations forums :
    Inscription : Septembre 2011
    Messages : 48
    Par défaut Code d'accès au snapshot du système sous 64 bit
    Bonjour,

    J'avais un code d'accès dans une macro Excel à la liste des processus lancés dans le système (en 32 bit). Je suis passé sous windows 7 64 bit. Maintenant ce code ne marche plus. Pourriez-vous me dire comment je peux régler ce problème ? Merci d'avance.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
     
     
    Option Explicit
     
    Private Const MAX_PATH As Long = 260
     
    Private Const TH32CS_SNAPPROCESS As Long = &H2
     
    Private Type PROCESSENTRY32
        dwSize As Long
        cntUsage As Long
        th32ProcessID As Long
        th32DefaultHeapID As Long
        th32ModuleID As Long
        cntThreads As Long
        th32ParentProcessID As Long
        pcPriClassBase As Long
        dwFlags As Long
        szExeFile As String * MAX_PATH
    End Type
     
     
    #If VBA7 Then
     
    Private Declare PtrSafe Function CreateToolhelp32Snapshot Lib "KERNEL32.dll" ( _
        ByVal dwFlags As Long, _
        ByVal th32ProcessID As Long) As Long
     
    Private Declare PtrSafe Function Process32First Lib "KERNEL32.dll" ( _
         ByVal hSnapshot As Long, _
         ByRef lppe As PROCESSENTRY32) As Long
     
    Private Declare PtrSafe Function Process32Next Lib "KERNEL32.dll" ( _
         ByVal hSnapshot As Long, _
         ByRef lppe As PROCESSENTRY32) As Long
     
     
    #Else
     
    Private Declare Function CreateToolhelp32Snapshot Lib "KERNEL32.dll" ( _
        ByVal dwFlags As Long, _
        ByVal th32ProcessID As Long) As Long
     
    Private Declare Function Process32First Lib "KERNEL32.dll" ( _
         ByVal hSnapshot As Long, _
         ByRef lppe As PROCESSENTRY32) As Long
     
    Private Declare Function Process32Next Lib "KERNEL32.dll" ( _
         ByVal hSnapshot As Long, _
         ByRef lppe As PROCESSENTRY32) As Long
     
    #End If
    Procédure d'appel :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
     
     
    Private Sub Workbook_Open()
     
     On Error Resume Next
     
     
        Dim SnapShot As Long
        Dim Proc As Long
        Dim SQL  As String
        Dim ProcessEnt As PROCESSENTRY32
        Dim i As Integer
     
     
       i = 0
     
        SnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
        ProcessEnt.dwSize = Len(ProcessEnt)
     
        Proc = Process32First(SnapShot, ProcessEnt)
        'Liste les processus
        While Proc
          'Pour le processus
          With ProcessEnt
     
         ' Debug.Print StrZToStr(.szExeFile)
     
          If StrZToStr(.szExeFile) = "ADM!R.exe" Then i = 1  'vérification de l'existance d'un exe lancé
     
          End With
     
          'Lire le processus suivant
          Proc = Process32Next(SnapShot, ProcessEnt)
        Wend
     
        If i = 0 Then
     
        Application.Quit
     
        Else
     
     
    End If
     
    End Sub

  2. #2
    Membre chevronné
    Profil pro
    Inscrit en
    Août 2010
    Messages
    345
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 345
    Par défaut
    Bonjour,

    Les api ont légèrement changé, il ne suffit pas de rajouter PtrSafe.
    Cordialement
    ctac
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    Private Const MAX_PATH As Long = 260
    'Private Const TH32CS_SNAPPROCESS As Long = &H2
    Private Const TH32CS_SNAPPROCESS = &H2
    #If VBA7 Then
    Private Declare PtrSafe Function CreateToolhelp32Snapshot Lib "KERNEL32.dll" ( _
        ByVal dwFlags As LongPtr, _
        ByVal th32ProcessID As LongPtr) As LongPtr
    Private Declare PtrSafe Function Process32First Lib "KERNEL32.dll" ( _
         ByVal hSnapshot As LongPtr, _
         ByRef lppe As PROCESSENTRY32) As Long
    Private Declare PtrSafe Function Process32Next Lib "KERNEL32.dll" ( _
         ByVal hSnapshot As LongPtr, _
         ByRef lppe As PROCESSENTRY32) As Long
    #Else
    Private Declare Function CreateToolhelp32Snapshot Lib "KERNEL32.dll" ( _
        ByVal dwFlags As Long, _
        ByVal th32ProcessID As Long) As Long
    Private Declare Function Process32First Lib "KERNEL32.dll" ( _
         ByVal hSnapshot As Long, _
         ByRef lppe As PROCESSENTRY32) As Long
    Private Declare Function Process32Next Lib "KERNEL32.dll" ( _
         ByVal hSnapshot As Long, _
         ByRef lppe As PROCESSENTRY32) As Long
    #End If
    #If Win64 Then
    Private Type PROCESSENTRY32
        dwSize As Long
        cntUsage As Long
        th32ProcessID As Long
        th32DefaultHeapID As Long
        th32DefaultHeapIDB As Long
        th32ModuleID As Long
        cntThreads As Long
        th32ParentProcessID As Long
        pcPriClassBase As Long
        pcPriClassBaseB As Long
        dwFlags As Long
        szExeFile As String * MAX_PATH
    End Type
    #Else
    Private Type PROCESSENTRY32
        dwSize As Long
        cntUsage As Long
        th32ProcessID As Long
        th32DefaultHeapID As Long
        th32ModuleID As Long
        cntThreads As Long
        th32ParentProcessID As Long
        pcPriClassBase As Long
        dwFlags As Long
        szExeFile As String * MAX_PATH
    End Type
    #End If
    Sub Workbook_Open()
    ' On Error Resume Next
        Dim SnapShot As LongPtr
        Dim Proc As Long
        Dim SQL  As String
        Dim ProcessEnt As PROCESSENTRY32
        Dim i As Integer
       i = 0
        SnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
        ProcessEnt.dwSize = Len(ProcessEnt)
        Proc = Process32First(SnapShot, ProcessEnt)
        'Liste les processus
        While Proc
          'Pour le processus
          With ProcessEnt
    '      Debug.Print StrZToStr(.szExeFile)
          Debug.Print .szExeFile
    '      If StrZToStr(.szExeFile) = "ADM!R.exe" Then i = 1  'vérification de l'existance d'un exe lancé
          End With
    i = i + 1
          'Lire le processus suivant
          Proc = Process32Next(SnapShot, ProcessEnt)
        Wend
        If i = 0 Then
    MsgBox "0"
    '    Application.Quit
        Else
    End If
    End Sub

  3. #3
    Membre confirmé
    Homme Profil pro
    Architecte technique
    Inscrit en
    Septembre 2011
    Messages
    48
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Maroc

    Informations professionnelles :
    Activité : Architecte technique
    Secteur : Bâtiment

    Informations forums :
    Inscription : Septembre 2011
    Messages : 48
    Par défaut Réglé
    Merci beaucoup. ça marche.

    cordialement,

    Ore

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Accès aux base de données sous Delphi 7 Edition Studio Perso
    Par renorx dans le forum Bases de données
    Réponses: 4
    Dernier message: 16/02/2005, 14h24
  2. Chemin d'accès des fichiers dans des sous rep
    Par Le Veilleur dans le forum C++Builder
    Réponses: 4
    Dernier message: 17/11/2004, 14h37
  3. [ADRESSAGE][DEBUTANT]Accés à une machine dans un sous-réseau
    Par Milark dans le forum Développement
    Réponses: 4
    Dernier message: 26/03/2004, 09h45

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo