MSInfo Report

I've got a program that uses MSInfo32's report function to create an output file that can be used to troubleshoot client's computers. My problem is that when I first started using this it took approximately 2-3 mins to generate the output of about 70 pages or so on my computer. I recently had a HDD failure and ever since I installed the new disk it's taking anywhere from 10 minutes to 2 hours to complete. My code remains unchanged, a modified about form.

Anyways, here is the code if anyone could test this and see if it's taking a significant amount of time I'd appreciate, or if you want to suggest another way of doing this. There is a commented hardcoded shell that I'm not presently using but put in to test if it would run any faster.

VB Code:

Public Sub MSInfo()
    On Error GoTo SysInfoErr
  
    Dim rc As Long
    Dim SysInfoPath As String
        
    ' Try To Get System Info Program Path\Name From Registry...
    If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
    ' Try To Get System Info Program Path Only From Registry...
    ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
        ' Validate Existance Of Known 32 Bit File Version
        If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
            SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
            
        ' Error - File Can Not Be Found...
        Else
            GoTo SysInfoErr
        End If
    ' Error - Registry Entry Can Not Be Found...
    Else
        GoTo SysInfoErr
    End If
    
    
    'Runs MSInfo and writes a report to the local directory.
    'Shell "cmd.exe /k c:\progra~1\common~1\micros~1\MSInfo\msinfo32.exe /report c:\MSInfo.txt"
    Call Shell(SysInfoPath & " /report MSInfo.txt", vbNormalFocus)
    
    Exit Sub
SysInfoErr:
    MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub

Output will be saved to the local directory. Thanks for any help, I don't have access to test on any other machines presently.