shell函数同步方式重复执行批处理文件内存不断增大问题

Question

最近需要处理一些数据，使用shell函数同步方式重复执行批处理文件,程序运行正常，但内存会不断增大，直到资源不足，程序无法运行，请高手指点，谢谢！！
Option Explicit
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 Long
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFF   ' Infinite timeout
Private Const WAIT_TIMEOUT = &H102&Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SystemTime) As Long
Private Type SystemTime
  wYear As Integer
  wMonth As Integer
  wDay As Integer
  wDayOfWeek As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type'shell and wait '执行外部命令并等待程序执行完毕再返回控制权Public Function ShellForWait(sAppName As String, Optional ByVal lShowWindow As VbAppWinStyle = vbMinimizedFocus, Optional ByVal lWaitTime As Long = 0) As Boolean  Dim lID As Long, lHnd As Long, lRet As Long
  'On Error Resume Next
  lID = Shell(sAppName, lShowWindow)
  If lID > 0 Then
    lHnd = OpenProcess(SYNCHRONIZE, 0, lID)
    If lHnd <> 0 Then
      Do
        lRet = WaitForSingleObject(lHnd, lWaitTime)
        DoEvents
      Loop While lRet = WAIT_TIMEOUT
      CloseHandle lHnd
      ShellForWait = True
    Else
      ShellForWait = False
    End If
  Else
    ShellForWait = False
  End IfEnd FunctionPrivate Sub Command1_Click()
Dim R As String, M As String, N As String'DCfile  '复制原始资料'循环开始
Do While DTPks.Value <= DTPjs.Value
  Dim NewTime As SystemTime
  NewTime.wYear = Year(DTPks.Value)
  NewTime.wMonth = Month(DTPks.Value)
  NewTime.wDayOfWeek = Day(DTPks.Value)
  NewTime.wHour = 0
  NewTime.wMinute = 10
  NewTime.wSecond = 0  SetSystemTime NewTime '修改系统时间
  
  ShellForWait "D:\micaps\datatran\t213.bat", vbNormalFocus, &HFFFF  ' Shell 调 处理资料
   
  ShellForWait App.Path & "\t213.exe", vbNormalFocus, &HFFFF  ' Shell 调 计算因子
  
  ShellForWait "D:\micaps\datatran\clrdisk.bat", vbNormalFocus, &HFFFF   ' Shell 调 删除资料
  
  DTPks.Value = DTPks.Value + 1
  R = Day(DTPks.Value)
  If R = "2" Then
     M = Month(DTPks.Value)
     If M = "5" Or M = "6" Or M = "7" Or M = "8" Or M = "9" Or M = "10" Then
        DCfile
     Else
        N = Year(DTPks.Value)
        N = Trim(Str(Val(N) + 1))
        DTPks.Value = N & "-5-2"
        DCfile
     End If
  End If
Loop MsgBox "读取结束"
 
End Sub

Answer 1

ShellForWait notepad 都会卡到要死..而且貌似没作用...

Answer 2

      Do 
        lRet = WaitForSingleObject(lHnd, lWaitTime) 
        DoEvents 
      Loop While lRet = WAIT_TIMEOUT 
你只是在超时后结束等待，说明 Shell 命令尚未结束。
当然会导致 Shell 启动的进程越来越多。
应当是 dwMilliseconds 参数为 INFINITE，循环结束判断用 WAIT_OBJECT_0。