vb 运行指定浏览路径的程序

win+r,运行窗口，如何用vb作？每指定路径自动保存路径不变，可以替换，能显示图标最好

用SHELL命令

'API声明： 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 * 1024 End Type Const TH32CS_SNAPHEAPLIST = &H1 Const TH32CS_SNAPPROCESS = &H2 Const TH32CS_SNAPTHREAD = &H4 Const TH32CS_SNAPMODULE = &H8 Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE) Const TH32CS_INHERIT = &H80000000 Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '窗体内部代码 '需要加入一个Timer控件，Interval属性设置为每多少毫秒检测一次。 Private Sub Timer1_Timer() '运行给定的进程 If fun_FindProcess(GetFileName_FromFullPathFile(Text1.Text)) = 0 Then RunExe Text1.Text End If

End Sub

'**************************************************************************************************** '作用: 查找进程的函数 '输入: 进程名称 '返回: 返回进程的PID Private Function fun_FindProcess(ByVal ProcessName As String) As Long Dim strdata As String Dim my As PROCESSENTRY32 Dim l As Long Dim l1 As Long Dim mName As String Dim i As Integer, pid As Long l = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0) If l Then my.dwSize = 1060 If (Process32First(l, my)) Then Do i = InStr(1, my.szExeFile, Chr(0)) mName = LCase(Left(my.szExeFile, i - 1)) If mName = LCase(ProcessName) Then pid = my.th32ProcessID fun_FindProcess = pid '返回进程的PID Exit Function End If Loop Until (Process32Next(l, my) < 1) End If l1 = CloseHandle(l) End If

fun_FindProcess = 0 '程序没有运行，返回0 End Function

'**************************************************************************************************** '作用: 运行程序的子程序 '输入: 程序名称 '返回: 无 Private Sub RunExe(ByVal ExeName As String) Call Shell("rundll32.exe url.dll,FileProtocolHandler " & ExeName, vbNormalFocus) End Sub

'**************************************************************************************************** '作用: 从完整路径获取 路径 '输入: 完整路径, 目录分隔符 '返回: 路径 Public Function GetPath_FromFullPathFile(ByVal strFullPath As String, Optional ByVal strSplitor As String = "\") As String GetPath_FromFullPathFile = Left$(strFullPath, InStrRev(strFullPath, strSplitor, , vbTextCompare)) End Function '**************************************************************************************************** '作用: 从完整路径获取 文件名 '输入: 完整路径, 目录分隔符 '返回: 文件名(带扩展名) Public Function GetFileName_FromFullPathFile(ByVal strFullPath As String, Optional ByVal strSplitor As String = "\") As String Dim i As Integer i = InStrRev(strFullPath, strSplitor) GetFileName_FromFullPathFile = Right(strFullPath, Len(strFullPath) - i) End Function