recherche du fichier excel.exe

Question

bonjour,

je souhaite dans mon programme vb6 récupérer le chemin du fichier excel.exe. Je n'ai rien trouvé de concluant sur ce site.

Merci d'avance.

barley · Answer

essaye ca, il doit y avoir beaucoup mieux... mais ca marche

'module de crenaud76 pour la fonction shellwait qui permet d'attendre la fin de l'execution avant de continuer la lecture du code
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400

Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long
    
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, vbMinimizedNoFocus))
    Do
        GetExitCodeProcess hProcess, RetVal
        DoEvents
        Sleep 100
    Loop While RetVal = STILL_ACTIVE
End Sub

Private Sub main()

'A initialisation et variables

Dim compteur, compteurlettres, textline, textinv, lettre, nomfichier, objet, objetfichier, fichiersource, repertoire
fichiersource = "c:	est.txt"
repertoire = "c:" & Chr(34) & "Program Files" & Chr(34)

'B éxécution de la commande DOS qui écrira tous les fichiers d'un dossier et de ces sous-dossiers dans un fichier source
ShellWait "cmd.exe /c dir /A-D /S /O:N /B " & repertoire & " > " & fichiersource 'execute commande DOS et stop la suite du programme tant que la commande DOS n'est pas terminée"

 
'C module de récupération du chemin de "excel.exe"
    Open fichiersource For Input As #1    ' Ouvre le fichier source.
        Do While Not EOF(1)    ' Effectue la boucle jusqu'à la fin du fichier source.
            Line Input #1, textline        ' Lit la ligne dans la variable.
            textinv = StrReverse(textline) ' inverse les caractères du texte de la ligne en cours
                If Left(textinv, 9) = "EXE.LECXE" Then 'si la fin de la ligne est bien excel.exe alors
                MsgBox textline
                End If
            
        Loop 'relance la boucle des lignes
    Close #1    ' Ferme le fichier.
    
'D module d'effacement du fichier source
Set objet = CreateObject("Scripting.FileSystemObject") ' crée un objet
Set objetfichier = objet.getfile(fichiersource)  'l'objet devient le fichier source
objetfichier.Delete True 'efface et force la suppression du fichier source
        
End Sub

barley · Answer

n'oublie pas d'effacer certaines variables qui te sont inutiles, c'est la reprise d'une appli... j'ai oublier d'enlever des variables

barley · Answer

comme ca , c'est un peu mieux

'module de crenaud76 pour la fonction shellwait qui permet d'attendre la fin de l'execution avant de continuer la lecture du code
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
Public Sub ShellWait(ByVal JobToDo As String)
Dim hProcess As Long, RetVal As Long
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(JobToDo, vbMinimizedNoFocus))
    Do
        GetExitCodeProcess hProcess, RetVal
        DoEvents
        Sleep 100
    Loop While RetVal = STILL_ACTIVE
End Sub
Private Sub main()
'A initialisation et variables
Dim textline, objet, objetfichier, fichiersource, repertoire
fichiersource = "c:	est.txt"
repertoire = "c:"
fichieratrouver = "excel.exe"
'B éxécution de la commande DOS qui écrira tous les fichiers d'un dossier et de ces sous-dossiers dans un fichier source
ShellWait "cmd.exe /c dir /A-D /S /O:N /B /L " & repertoire & " > " & fichiersource 'execute commande DOS et stop la suite du programme tant que la commande DOS n'est pas terminée"
'C module de récupération du chemin de "excel.exe"
    Open fichiersource For Input As #1    ' Ouvre le fichier source.
        Do While Not EOF(1)    ' Effectue la boucle jusqu'à la fin du fichier source.
            Line Input #1, textline        ' Lit la ligne dans la variable.
                If Left(StrReverse(textline), Len(fichieratrouver)) = StrReverse(fichieratrouver) Then 'si la fin de la ligne est bien fichieratrouver alors
                MsgBox textline
                End If
        Loop 'relance la boucle des lignes
    Close #1    ' Ferme le fichier.
'D module d'effacement du fichier source
Set objet = CreateObject("Scripting.FileSystemObject") ' crée un objet
Set objetfichier = objet.getfile(fichiersource)  'l'objet devient le fichier source
objetfichier.Delete True 'efface et force la suppression du fichier source
End Sub

si ca va pas, n'hesite pas

cs_CanisLupus · Answer

Une autre solution, en passant par les API's interrogeant la base de registre :

' Dans un module
Private Declare Function RegOpenKey _
  Lib "advapi32" Alias "RegOpenKeyA" _
    ( _
      ByVal hKey As Long, _
      ByVal lpSubKey As String, _
      phkResult As Long _
    ) As Long

Private Declare Function RegQueryValueEx _
  Lib "advapi32" Alias "RegQueryValueExA" _
    ( _
      ByVal hKey As Long, _
      ByVal lpValueName As String, _
      ByVal lpReserved As Long, _
      lpType As Long, _
      lpData As Any, _
      lpcbData As Long _
    ) As Long

Public Function GetString(hKey As Long, strPath As String, strValue As String) As String
Dim Keyhand As Long, lResult As Long
Dim strBuf As String * 255

  RegOpenKey hKey, strPath, Keyhand
  lResult = RegQueryValueEx(Keyhand, strValue, 0&, 0&, ByVal strBuf, 255)  If lResult 0 Then GetString Split(strBuf, Chr$(0))(0)
  
End Function

' Dans ta form
Private Sub Form_Load()
Dim s As String
s = GetString(&H80000000, "Excel.Application\CLSID", "")
s = GetString(&H80000000, "CLSID" & s & "\LocalServer32", "")
s = Trim(Left$(s, InStr(1, s, "/") - 1))
MsgBox s
End Sub


Explik :
d'abord on lit la CLSID de l'appli puis on va lire la localisation de l'exe.
le trim .... est là pour zapper les "/automation" et autres paramètres de lancement pour ne récupérer que le chemin.

Bien sùr, puisque la CLSID des applis Windows est toujours la même, dans le form_lod on peut juste mettre :

Private Sub Form_Load()
Dim s As String
s = GetString(HKEY_CLASSES_ROOT, "CLSID\{00024500-0000-0000-C000-000000000046}\LocalServer32", "")
s = Trim(Left$(s, InStr(1, s, "/") - 1))
MsgBox s
End Sub


Mais bon, on ne sait jamais et ça prend pas beaucoup plus de temps.

Et ça, c'est rapide, ça marche avec VB, VBA et VB.NET, sous win9x et winXP. J'ai testé mais si prob, j'attend les critiques.

Cordialement, CanisLupus

barley · Answer

salut canislupus, je viens d'essayer ta technique, ca me parait tres bien, je n'en suis pas encore a ce niveau
Par contre, est ce que c'est normal de voir le chemin sous forme "raccourci", exemple:

C:\PROGRA~1\MICROS~4\Office\EXCEL.EXE

et surtout, est ce que ceci est exploitable après... si oui pas de problème
moi je dis bravo...

barley · Answer

Je viens d'essayer en rajoutant shell (s), ca marche, donc je m'incline...
lol
allez, bonne prog a vous

cs_CanisLupus · Answer

G même envie de rajouter qu'on peut faire ça avec Word.Application, Access.Application et Powerpoint.Application.
Pour les autres applis, je vous laisse découvrir.
Faut juste aller se balader, avec précaution, dans la registry (HKEY_CLASSES_ROOT pour cet exemple) .

Pour la forme et pour la sécurité, je dois signaler que toutes modifs dans la registry mal maitrisées peuvent provoquer un plantage grave du système. S'il ne s'agit que d'un get (lecture) pas de problème mais en cas de Set (écriture), si vous n'êtes pas sûr, sauvegardez votre registry avant.

Cordialement, CanisLupus

domsig · Answer

je vais peut-être dire une bêtise mais..........

dim excel_object as object
Set excel_object = CreateObject("excel.application")
If IsNull(excel_object) Then
     msgbox("pas trouvé")
else
     msgbox(excel_object.path)
     'on peut aussi tester la version d'excel trouvée
     msgbox(excel_object.version)
end if

voilà voilà voilà.....

cs_CanisLupus · Answer

Tu ne dis pas une bêtise domsig c'est plus court à coder mais plus long en exec et faut pas oublier un tit set excel_object = nothing à la fin (juste histoire de libérer la mémoire).

Je m'explique, mon code va voir directement dans la registry et le tien crée un objet donc plus lent.

A chacun sa méthode.

Cordialement, CanisLupus

Recherche du fichier excel.exe

9 réponses

Discussions similaires