hola
aka les dejo lo q logre hacer fijen se si no tiene algún choclo y si se puede mejorar graciass.
Module1.bas
Option Explicit
'<lapis
Private Declare Function EnumProcesses Lib "PSAPI.DLL" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
'lapis>
'<constantes
Private Const PROCESS_VM_READ As Long = (&H10)
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)
Private Const SW_SHOWNORMAL = 1
Private Const WM_CLOSE = &H10
'Private Const gcClassnameMSWord = "OpusApp"
'Private Const gcClassnameMSExcel = "XLMAIN"
'Private Const gcClassnameMSIExplorer = "IEFrame"
'Private Const gcClassnameMSVBasic = "wndclass_desked_gsk"
'Private Const gcClassnameNotePad = "Notepad"
'Private Const gcClassnameMyVBApp = "ThunderForm"
'Private Const gcClassnameFolder = CabinetWClass 'De explorer.exe
'constantes>
'procedimiento >>
Public Sub GetPathProces(Optional ClassName As String = vbNullString, Optional WindowsName As String = vbNullString)
On Error GoTo eler
Dim WinWnd As Long, ret As String, lpClassName As String
Dim Buffer As String
Dim i_Procesos As Long
Dim Array_Procesos() As Long, RetVal As Long
Dim sd As Long
Dim ret1 As Long
Dim Ruta As String
Dim t_cbNeeded As Long
Dim Handle_Proceso As Long
Dim i As Long
ReDim Array_Procesos(250) As Long
' Recoje el handle de la ventana
WinWnd = FindWindow(vbNullString, ret)
If WinWnd = 0 Then MsgBox "Couldn't find the window ...": Exit Sub
lpClassName = Space(256)
RetVal = GetClassName(WinWnd, lpClassName, 256)
MsgBox "Classname: " + Left$(lpClassName, RetVal)
' Carga la variable sd con la id del proceso
GetWindowThreadProcessId WinWnd, sd
' Obtiene un array con los id de los procesos
ret = EnumProcesses(Array_Procesos(1), 1000, t_cbNeeded): i_Procesos = t_cbNeeded / 4
' Recorre todos los procesos
For i = 1 To i_Procesos
If Array_Procesos(i) = sd Then
' Lo abre y devuelve el handle
Handle_Proceso = OpenProcess(PROCESS_QUERY_INFORMATION + PROCESS_VM_READ, 0, Array_Procesos(i))
If Handle_Proceso <> 0 Then
' Crea un buffer para almacenar el nombre y ruta
Buffer = Space(255)
' Le pasa el Buffer al Api y el Handle
ret1 = GetModuleFileNameExA(Handle_Proceso, 0, Buffer, 255)
' Le elimina los espacios nulos a la cadena devuelta
Ruta = Left(Buffer, ret1)
End If
' Cierra el proceso abierto
ret1 = CloseHandle(Handle_Proceso)
' Muestra la ruta del proceso y ee id
MsgBox Ruta & " " & Array_Procesos(i), vbInformation, "info"
Exit For
End If
DoEvents
Next
Exit Sub
eler:
MsgBox Err.Description, vbCritical, "Esto no tendria q haber pasado."
End Sub
Sub main()
GetPathProces , InputBox("Escriba el titulo de una ventana.", "prueva uno", "ej: Mi Pc", (Screen.Width / 2) - 2500, (Screen.Height / 2) - 1500)
End Sub
un 90(0 d3 (091 94573 n0 l3 h483 m4l 4 n4d13