关于 主程序调用子程序 运行错误
1、在开始的时候没有注意到这一点，以为vb有编译不成功、编译成功两种情况，编译成功有运行成功、运行不成功两种情况，运行不成功也没有想到它们很在不受控制的弹出警告框，一开始的时候其实也注意到除数为零、数组越界、为声明变量等问题，感觉那是些逻辑上错误，挺多不会出现预期的结果，可是…… 郁闷。
开始的思路 编译->运行。这里的运行使用shell命令，直接调用的。到现在突然出现运行错误无法控制了。怎么办？？？
Dim WindH As LongDim hWnd As LongDim hWndParent As Long '父窗体句柄Dim ParentTitle As Long '父窗体标题Dim ParentTitleBuffer As StringDim CountControl As DoubleCountControl = 0shellval = Shell(ExeFile, vbHide) '如果编译成功调用shell运行学生程序Sleep 1000If shellval <> 0 ThenfrmMain.RichTextBox1.Text = frmMain.RichTextBox1.Text & filestudent & "成功执行" & vbCrLfEnd IfhWndParent = FindWindow(vbNullString, "Form1") '父窗体句柄Sleep 100 ParentTitleBuffer = String(20, 0)ParentTitle = GetWindowText(hWndParent, ParentTitleBuffer, 255) '父窗体标题RichTextBox1.Text = RichTextBox1.Text & filestudent & Space(2) & "父窗体句柄:" & hWndParent & Space(2) & "窗体名称：" & ParentTitleBuffer & vbCrLfRichTextBox1.Text = RichTextBox1.Text & "*******************************************************" & vbCrLfIf hWndParent <> 0 Then ret = EnumChildWindows(hWndParent, AddressOf EnumChildProc, 0) RichTextBox1.Text = RichTextBox1.Text & "*******************************************************" & vbCrLfSleep 1000End IfAdodcFrmMainMessage.RecordSource = "select * from [Message] where wordId='" & wordid & "' "'MsgBox "adodc" & AdodcFrmMainMessage.RecordSourceDim i As Integer AdodcFrmMainMessage.Refresh For i = 0 To AdodcFrmMainMessage.Recordset.RecordCount - 1 Dim tempParent As Long '临时父句柄 Dim temp As Long '临时子窗体句柄 'MsgBox "ParentTitle" & Len(AdodcFrmMainMessage.Recordset.Fields("ParentTitle")) & Trim(AdodcFrmMainMessage.Recordset.Fields("ParentTitle")) & "voer" If Mid$(AdodcFrmMainMessage.Recordset.Fields("ParentTitle"), 1) = "Form1" Then ' 判断是否是Form1的直接孩子窗体 temp = FindWindowEx(hWndParent, 0, vbNullString, AdodcFrmMainMessage.Recordset.Fields("Caption")) 'MsgBox "temp" & temp & AdodcFrmMainMessage.Recordset.Fields("Caption") Else tempParent = FindWindowEx(hWndParent, 0, vbNullString, AdodcFrmMainMessage.Recordset.Fields("ParentTitle")) ' MsgBox "tempParent" & tempParent & "hwndparent" & hWndParent temp = FindWindowEx(tempParent, 0, vbNullString, AdodcFrmMainMessage.Recordset.Fields("Caption")) 'MsgBox "标题" & AdodcFrmMainMessage.Recordset.Fields("Caption") End If If temp <> 0 Then Dim tempClassBuffer As String tempClassBuffer = Space(MAX_PATH)' ret = RealGetWindowClass(hwnd, dwWindowClassBuffer, MAX_PATH) retval = GetClassName(temp, tempClassBuffer, MAX_PATH) ClassName = StrConv(LeftB(StrConv(tempClassBuffer, vbFromUnicode), retval), vbUnicode) '去掉不可打印的字符 ClassName = Trim(ClassName) 'MsgBox "classname" & Len(ClassName) & ClassName & "over" If retval <> 0 Then If ClassName = "ThunderRT6OptionButton" Or ClassName = "ThunderRT6CheckBox" Then SendMessage temp, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0) End If If ClassName = "ThunderRT6CommandButton" Then SendMessage temp, WM_LBUTTONDOWN, 0, ByVal &H10001 Sleep 100 SendMessage temp, WM_LBUTTONUP, 0, ByVal &H10001 End If End If End If AdodcFrmMainMessage.Recordset.MoveNext Next PostMessage hWndParent, WM_CLOSE, 0, 0 '关闭窗口 Call WordIdControlKeyCall WordIdkeyscore = Round(wordM * WordIdControlKey * WordIdkey, 2) '四舍五入保留两位小数Adodc2.Refresh ' adodc2先刷新 要不会覆盖上一条记录Adodc2.Recordset.AddNewAdodc2.Recordset.Fields("stuid") = stuidAdodc2.Recordset.Fields("score") = Format(score, "0.00") '截取两位Adodc2.Recordset.Update
On Error Resume Next Dim si As STARTUPINFO '该结构用于指定新进程的主窗口特性 Dim pi As PROCESS_INFORMATION '在创建进程时相关的数据结构之一，该结构返回有关新进程及其主线程的信息 Dim hReadPipe As Long ' 负责读取的管道 Dim hWritePipe As Long '负责Shell程序的标准输出和标准错误输出的管道 Dim sOutput As String '放返回的数据 Dim sa As SECURITY_ATTRIBUTES Dim ret As Long Dim retval As Long ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)If ret = 0 ThenMsgBox "createPipe failed"'error: Err.LastDllErrorExit SubEnd If Dim strResult As String ''returned results of the command line With sa .nLength = Len(sa) .bInheritHandle = 1& ''inherit, needed for this to work .lpSecurityDescriptor = 0 End With With si .cb = Len(si) .dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW ''tell it to use (not ignore) the values below .wShowWindow = SW_HIDE .hStdOutput = hWritePipe ''pass the write end of the pipe as the processes standard output End With Dim Hwind As Long Dim FHandle As Long Dim SM As Long retval = CreateProcess(vbNullString, "D:\Tomcat 4.1\webapps\myexam\program\student\2220063892-w025\工程1.exe", sa, sa, 1&, DEBUG_PROCESS, ByVal 0&, vbNullString, si, pi)' If retval = 0 Then' MsgBox "retval " & retval' End If Dim WindH As Long Dim hwnd As Long Dim hWndParent As Long '父窗体句柄 Dim ParentTitle As Long '父窗体标题 Dim ParentTitleBuffer As String hWndParent = FindWindow(vbNullString, "Form1") '父窗体句柄 Sleep 100 ParentTitleBuffer = String(20, 0) ParentTitle = GetWindowText(hWndParent, ParentTitleBuffer, 255) '父窗体标题 MsgBox "hwndparent" & hWndParent & "标题" & ParentTitleBuffer Sleep 1000 If hWndParent <> 0 Then'---------------------查找对应的控件 8个---------------------------------'MsgBox "hwndparent" & hWndParent Dim tempHandleZiXing As Long tempHandleZiXing = FindWindowEx(hWndParent, 0, "ThunderRT6Frame", "字型") If tempHandleZiXing = 0 Then MsgBox "字型" & tempHandleZiXing, vbOKCancel, "提示信息" End If Dim tempHandleZiTi As Long tempHandleZiTi = FindWindowEx(hWndParent, 0, "ThunderRT6Frame", "字体") If tempHandleZiTi <> 0 Then 'List2.AddItem tempHandleZiTi & "字体" MsgBox "字体" End If Dim tempHandleSong As Long tempHandleSong = FindWindowEx(tempHandleZiTi, 0, "ThunderRT6OptionButton", "宋体") If tempHandleSong <> 0 Then MsgBox "宋体" ' List2.AddItem tempHandleSong & "宋体" End If Dim tempHandleHeiTi As Long tempHandleHeiTi = FindWindowEx(tempHandleZiTi, 0, "ThunderRT6OptionButton", "黑体") If tempHandleHeiTi <> 0 Then MsgBox "黑体" ' List2.AddItem tempHandleHeiTi & "黑体" SendMessage tempHandleHeiTi, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0) End IfDim tempHandleFontUnderLine As LongtempHandleFontUnderLine = FindWindowEx(tempHandleZiXing, 0, "ThunderRT6CheckBox", "下划线")If tempHandleFontUnderLine <> 0 Then'List2.AddItem tempHandleFontUnderLine & "下划线"MsgBox "下划线" SendMessage tempHandleFontUnderLine, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)End IfDim tempHandleFontItlic As LongtempHandleFontItlic = FindWindowEx(tempHandleZiXing, 0, "ThunderRT6CheckBox", "斜体")If tempHandleFontItlic <> 0 Then'List2.AddItem tempHandleFontItlic & "斜体" MsgBox "斜体" SendMessage tempHandleFontItlic, BM_SETCHECK, ByVal CLng(1), ByVal CLng(0)End IfDim tempHandleText As LongtempHandleText = FindWindowEx(hWndParent, 0, vbNullString, "请选择字体和字型")If tempHandleText <> 0 ThenMsgBox "请选择字体和字型"'List2.AddItem tempHandleText & "请选择字体和字型"End If Dim tempHandleCommand '确定按钮 发送消息 tempHandleCommand = FindWindowEx(hWndParent, 0, "ThunderRT6CommandButton", "确定") If tempHandleCommand <> 0 Then MsgBox "确定" & tempHandleCommand SendMessage tempHandleCommand, WM_LBUTTONDOWN, 0, ByVal &H10001 Sleep 100 SendMessage tempHandleCommand, WM_LBUTTONUP, 0, ByVal &H10001 End If PostMessage hWndParent, WM_CLOSE, 0, 0 End IfEnd Sub