Question

我有一个导出文本文件的程序，然后由可执行文件使用它来运行模拟，每个模拟通常需要5到10分钟。

我创建了一个运行此进程For Each文本文件的for循环。我最初编写了一个单独的可执行文件的代码，VBA宏将调用它，这将运行每个模拟系列。我希望能够并行运行更多，因此我将宏直接传输到VBA，但这会导致每个模拟同时运行并使处理器爬行。

有没有办法允许一次运行有限数量的模拟？

编辑：对不起，我是用电话写的，因为当时我的电脑遇到了这个问题。这是代码。我有一个运行一个模拟的函数，它将所需的exe（每个模拟相同）和input.txt文件移动到它自己的子文件夹中，第二个函数在循环列表选项上运行第一个函数：

Function RunSimulations() As Boolean
    For k = 0 To myListBox.ListCount - 1
        If myListBox.Selected(k) = True Then
               SimulateOne(myListBox.List(k))
            End If
        End If
    Next k
End Function

Function SimulateOne(inputFName As String) As Boolean
    Dim currPath As String, inptPath As String, simsPath As String
    Dim destPath As String, origFile As String, destFile As String

    'Defines various folder paths
    currPath = ThisWorkbook.Path & "\"
    inptPath = currPath & INPUT_FOLDERNAME & "\"
    simsPath = currPath & SIMS_FOLDERNAME & "\"
        If Len(Dir(simsPath, vbDirectory)) = 0 Then MkDir simsPath
    destPath = simsPath & Replace(inputFName, ".txt", "") & "\"
        If Len(Dir(destPath, vbDirectory)) = 0 Then MkDir destPath

    'Move input files from "input_files" to subfolders within "simulations"
    origFile = inptPath & inputFName
    destFile = destPath & INPUT_FILENAME  'Changes name to "INPUT.TXT"
    If Len(Dir(destFile)) <> 0 Then SetAttr destFile, vbNormal: Kill destFile
    If Len(Dir(origFile)) <> 0 Then
        FileCopy origFile, destFile
    Else
        SimulateOne = False
        Exit Function
    End If

    If Len(Dir(currPath & EXE_FILENAME)) <> 0 Then
        'Moves exe files to new subfolder within "simulations"
        FileCopy currPath & EXE_FILENAME, destPath & EXE_FILENAME

        'Run exe
        ChDrive Left(destPath, 1)
        ChDir destPath
        Shell (destPath & EXE_FILENAME)
        SimulateOne = True
    Else
        SimulateOne = False
        Exit Function
    End If

End Function

编辑：最近实施了这个循环。想知道循环的效率（或缺乏效率）一直持续到处理器数量下降到足够低的程度。

For k = 0 To myListBox.ListCount - 1
    Do While ProcessRunningCount(EXE_FILENAME) >= processLimit
        Application.Wait (Now + TimeValue("0:00:05"))
    Loop
    If myListBox.Selected(k) = True Then  runResult = SimulateOne(myListBox.List(k))
Next k

Answer 1

答案就像在循环中等待一段时间一样简单。这可以在一定程度上控制进程的数量。这将开始一次，等待五分钟，开始下一次，等待五分钟，开始下一次等等。

Function RunSimulations() As Boolean
    For k = 0 To myListBox.ListCount - 1
        If myListBox.Selected(k) = True Then
            SimulateOne(myListBox.List(k))
            Application.Wait (Now + TimeValue("0:05:00"))
        End If
    Next k
End Function

如果这还不够好，我有一些可以使用的VBA功能。

'API Calls - place these at the top of your code with your globals
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 EnumProcesses Lib "PSAPI.DLL" ( _
    lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
    ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
    ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400

只需输入proc名称b = IsProcessRunning（“ProcName.exe”）

Private Function IsProcessRunning(ByVal sProcess As String) As Boolean
'Check to see if a process is currently running
Const MAX_PATH      As Long = 260
Dim lProcesses()    As Long
Dim lModules()      As Long
Dim N               As Long
Dim lRet            As Long
Dim hProcess        As Long
Dim sName           As String

sProcess = UCase$(sProcess)
ReDim lProcesses(1023) As Long

If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
    For N = 0 To (lRet \ 4) - 1
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
        If hProcess Then
            ReDim lModules(1023)
            If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
                sName = String$(MAX_PATH, vbNullChar)
                GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
                sName = Left$(sName, InStr(sName, vbNullChar) - 1)
                If sProcess = UCase$(sName) Then
                    IsProcessRunning = True
                    Exit Function
                End If
            End If
        End If
        CloseHandle hProcess
    Next N
End If
End Function

你可能想要这个。它将返回找到进程的时间。如果它超过你想要的运行。不要踢别的。

Private Function ProcessRunningCount(ByVal sProcess As String) As Long
'Check to see if how many occurences of a process are currently running
Const MAX_PATH      As Long = 260
Dim lProcesses()    As Long
Dim lModules()      As Long
Dim N               As Long
Dim lRet            As Long
Dim hProcess        As Long
Dim sName           As String
Dim lCount          As Long

    sProcess = UCase$(sProcess)
    ReDim lProcesses(1023) As Long
    lCount = 0

    If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
        For N = 0 To (lRet \ 4) - 1
            hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
            If hProcess Then
                ReDim lModules(1023)
                If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
                    sName = String$(MAX_PATH, vbNullChar)
                    GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
                    sName = Left$(sName, InStr(sName, vbNullChar) - 1)
                    If sProcess = UCase$(sName) Then
                        lCount = lCount + 1
                    End If
                End If
            End If
            CloseHandle hProcess
        Next N
    End If
    ProcessRunningCount = lCount

End Function

像这样的东西

Function RunSimulations() As Boolean
    For k = 0 To myListBox.ListCount - 1

        Do While ProcessRunningCount("chrome.exe") >= 5 'Enter you proc name here
            Application.Wait (Now + TimeValue("0:00:10"))
        Loop

        If myListBox.Selected(k) = True Then
            SimulateOne(myListBox.List(k))
        End If
    Next k
End Function

Answer 2

编辑：好的，这是您想要做的事情的经过测试的实施。我正在使用一个简单的vbscript来模拟你的exe（所以我正在监视“wscript.exe”）

if(typeof data.items === "undefined" || data.items === null)

限制for循环调用的可执行文件的实例数

2 个答案: