Collect performance counters while running QTP tests

Following code can be run using QTP and will collect Memory/Processor/disktime and networkinterface counters while testing.
Useful when doing application profiling on your automated tests.
(copy/Paste to editor of choice to see full code)

Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile("c:\testfile.txt", True)

strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
set PerfProcess = objWMIService.Get("Win32_PerfFormattedData_PerfProc_Process.Name='explorer'")
tmp = ""

set objRefresher = CreateObject("WbemScripting.SWbemRefresher")
Set objMemory = objRefresher.AddEnum (objWMIService, "Win32_PerfFormattedData_PerfOS_Memory").objectSet
Set objMemory2 = objRefresher.AddEnum (objWMIService, "Win32_PerfFormattedData_PerfOS_Processor").objectSet
Set objMemory3 = objRefresher.AddEnum (objWMIService, "Win32_PerfFormattedData_PerfDisk_LogicalDisk").objectSet
Set objMemory4 = objRefresher.AddEnum (objWMIService, "Win32_PerfFormattedData_Tcpip_NetworkInterface").objectSet
objRefresher.Refresh
Do
    tmp = Now
    For each intAvailableBytes in objMemory
    if not isnull(intAvailableBytes) then
        tmp = tmp & ";" & intAvailableBytes.AvailableMBytes
    end if
    Next
    For each intProc in objMemory2
    if not isnull(intProc) then
        tmp = tmp & ";" & intProc.PercentProcessorTime
    end if
    Next
    For each intIO in objMemory3
    if not isnull(intIO) then
        tmp = tmp & ";" & intIO.PercentDiskTime
    end if
    Next
    For each intIO in objMemory4
    if not isnull(intIO) then
    tmp = tmp & ";" & intIO.BytesReceivedPersec
    tmp = tmp & ";" & intIO.BytesSentPersec
    tmp = tmp & ";" & intIO.BytesTotalPersec
    end if
    Next
    MyFile.writeLine tmp
    tmp = ""
    objRefresher.Refresh
    wscript.sleep 1000
Loop