recherche du fichier excel.exe

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.

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:\test.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

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

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:\test.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

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

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...

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

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

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à.....

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