So far I have only been able to get an accurate name for the CPU via the registry. Although I am not sure if the key will always be:

HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\CentralProcessor\0

Specifically I am not sure if this will work on CPUs with only one or dual core?
I have tested it on WinXP and 7 with quad cores and it seems to work.

Declarations:
Code:
'----------------------------------------
' Declarations for registry read for CPU name

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const REG_SZ = 1
Function:
Code:
Public Function regCPUName() As String
    Dim Hkey As Long, StrValue As String, LenValue As Long, a, i&
    
    ' open the hardware key in local machine
    Call RegOpenKey(HKEY_LOCAL_MACHINE, "HARDWARE\DESCRIPTION\System\CentralProcessor\0", Hkey&)
    ' determine the length of string returned via lenvalue
    Call RegQueryValueEx(Hkey&, "ProcessorNameString", 0&, REG_SZ, vbNullString, LenValue&)
    ' make string to hold the key value
    StrValue$ = Space$(LenValue)
    ' get the registry value
    Call RegQueryValueEx(Hkey&, "ProcessorNameString", 0&, REG_SZ, ByVal StrValue$, Len(StrValue$))
    Call RegCloseKey(Hkey&)
    ' finally remove any multiple spaces in the string
    a = Split(StrValue, " ")
    For i = 0 To UBound(a)
    If Len(a(i)) Then regCPUName = regCPUName & a(i) & " "
    Next i
End Function
Called like this:
Code:
Private Sub Command1_Click()
MsgBox regCPUName
End Sub