VB function to find MS-Excel Product ID 3

Option Explicit

Declare Function GetVolumeInformation Lib "kernel32" _
        Alias "GetVolumeInformationA" _
        (ByVal lpRootPathName As String, _
        ByVal lpVolumeNameBuffer As String, _
        ByVal nVolumeNameSize As Long, _
        lpVolumeSerialNumber As Long, _
        lpMaximumComponentLength As Long, _
        lpFileSystemFlags As Long, _
        ByVal lpFileSystemNameBuffer As String, _
        ByVal nFileSystemNameSize As Long) As Long

Sub Main()
    Dim lpRootPathName As String
    Dim lpVolumeNameBuffer As String
    Dim nVolumeNameSize As Long
    Dim lpVolumeSerialNumber As Long
    Dim lpMaximumComponentLength As Long
    Dim lpFileSystemFlags As Long
    Dim lpFileSystemNameBuffer As String
    Dim nFileSystemNameSize As Long
    Dim ReturnVal As Long
    
    lpRootPathName = "C:\"
    
    ReturnVal = GetVolumeInformation _
               (lpRootPathName, _
                lpVolumeNameBuffer, _
                nVolumeNameSize, _
                lpVolumeSerialNumber, _
                lpMaximumComponentLength, _
                lpFileSystemFlags, _
                lpFileSystemNameBuffer, _
                nFileSystemNameSize)
    
    MsgBox "Serial No: " & lpVolumeSerialNumber
End Sub

Declare Function GetUserName Lib _
        "advapi32.dll" Alias "GetUserNameA" _
        (ByVal lpBuffer As String, _
        nSize As Long) As Long

Sub GetUserName()
    Dim lpBuff As String * 25
    Dim ret As Long, UserName As String
    
    ret = GetUserName(lpBuff, 25)
    UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
    UserName = UCase(UserName)

    MsgBox UserName
End Sub

 msgbox Application.ProductCode