How to run two do loops at the same time on VBScript - vbscript

Question

I'm trying to make it so my code runs 2 do loops at a time so it can run the open disk drive code and spam caps lock code at the same time. Any way I could do this?
Set oWMP = CreateObject("WMPlayer.OCX.7")
Set colCDROMs = oWMP.cdromCollection
x=msgbox("Keyboard error with key CAPS LOCK",0,"Critical Error")
x=msgbox("Error with CD Drive",0,"Critical Error")
Set wshShell =wscript.CreateObject("WScript.Shell")
message= "Critical Disk Drive Error Alert Call Microsoft Support at 0 3 4 4 8 0 0 2 4 0 0 to resolve the issue"
message1= "Caps Lock key Error"
Dim message, sapi
Set sapi=CreateObject("sapi.spvoice")
sapi.Speak message
sapi.Speak message1
do
if colCDROMs.Count >= 1 then
For i = 0 to colCDROMs.Count -1
colCDROMs.Item(i).Eject
Next
For i = 0 to colCDROMs.Count -1
colCDROMs.Item(i).Eject
Next
End If
wscript.sleep 100
wshshell.sendkeys "{CAPSLOCK}"
wscript.sleep 100
loop

Answer 1

Take a look at the below example:
CheckTask ' always at the begining of the script
LaunchTask "EjectCdRoms" ' friendly keep CD-ROMs opened
LaunchTask "MsgA" ' friendly show the message A
LaunchTask "MsgB" ' friendly show the message B
LaunchTask "Speak" ' friendly speak
' procedures to be launched asynchronously
Sub EjectCdRoms()
Dim i
On Error Resume Next
Do
With CreateObject("WMPlayer.OCX.7").cdromCollection
For i = 0 To .Count - 1
.Item(d).Eject
Next
End With
WScript.Sleep 500
Loop
End Sub
Sub MsgA()
Do
WScript.Sleep 3000
MsgBox "Critical Disk Drive Error Alert Call Microsoft Support at 03448002400 to resolve the issue", 48, "Blah"
Loop
End Sub
Sub MsgB()
Do
WScript.Sleep 5000
MsgBox "Caps Lock key Error", 48, "Blah"
Loop
End Sub
Sub Speak()
Do
With CreateObject("SAPI.SpVoice")
WScript.Sleep 4000
.Speak "Critical Disk Drive Error Alert Call Microsoft Support at 0 3 4 4 8 0 0 2 4 0 0 to resolve the issue"
WScript.Sleep 4000
.Speak "Caps Lock key Error"
End With
Loop
End Sub
' utility procedures, do not modify
Sub CheckTask()
If WScript.Arguments.Named.Exists("task") Then
On Error Resume Next
Execute WScript.Arguments.Named.Item("task")
WScript.Quit
End If
End Sub
Sub LaunchTask(sTaskName)
CreateObject("WScript.Shell").Exec """" & WScript.FullName & """ """ & WScript.ScriptFullName & """ ""/task:" & sTaskName & """"
End Sub