Option Explicit Private Const SYNCHRONIZE = &H100000 Private Const INFINITE = &HFFFFFFFF Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function GetExitcodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitcode As Long) As LongPrivate Const STATUS_PENDING = &H103&Private Const sVBPath = "C:\Program Files\Microsoft Visual Studio\VB98\vb6.exe /m "Private Const sVBFormFolder = "D:\vbsource\HABS\Form"Dim sSourcePath As StringPrivate Sub RunShell(cmdline As String)Dim hProcess As LongDim ProcessId As LongDim exitCode As LongProcessId = Shell(cmdline, 1)hProcess = OpenProcess(SYNCHRONIZE, False, ProcessId) If hProcess <> 0 Then WaitForSingleObject hProcess, INFINITECall CloseHandle(hProcess)End If'MsgBox cmdline & "Closed"End Sub'//遍历目录得到vbp 工程文件并编译Function SearchVbp(sPath)Dim fso, f, f1, fc, s, ff, ff1Set fso = CreateObject("Scripting.FileSystemObject")Set f = fso.GetFolder(sPath)Set fc = f.FilesFor Each f1 In fc'msgbox InStr(f1.Name, "ABS")If (LCase(GetFileExtName(f1.Name)) = "vbp") And InStr(f1.Name, "ABS") = 1 Then ' If InStr(f1.Name, "ABS") = 1 Then MsgBox f1.Path MakeDll (f1.Path) ' End IfEnd IfNextSet ff = f.subFoldersFor Each ff1 In ffSearchVbp (ff1.Path)NextEnd Function'//得到扩展名Function GetFileExtName(sFileName)Dim ipos, ilenipos = InStr(sFileName, ".")ilen = Len(sFileName)GetFileExtName = Right(sFileName, ilen - ipos)End FunctionPrivate Sub Command1_Click() SearchVbp (sVBFormFolder)End Sub'// 编译Function MakeDll(sVBP) RunShell sVBPath & sVBPEnd Function
相关资源：VB 递归算法例子
