xiaoyao - re HOW TO GET ALL disk sn

Try using the SWbemObjectSet and extract each SWbemObject.SerialNumber.
The format of the serial number can vary, I have used the following code to explore these:
Function Convert(vSerialNumber As Variant) As String
Code:
Dim MayBeHex        As Boolean
Dim i               As Long
Dim InHex           As String
Dim lHex            As Long
Dim lAsc1           As Long
Dim lAsc2           As Long
Dim SerialNumber    As String

    On Error GoTo EH 
    If VarType(vSerialNumber) <> vbString Then
        Convert = vbNullString
    Else
        SerialNumber = vSerialNumber
        InHex = vbNullString
        MayBeHex = (Len(SerialNumber) > 0)
        For i = 1 To Len(SerialNumber) - 1 Step 2
            lAsc1 = AscW(Mid$(SerialNumber, i, 1))
            Select Case lAsc1
            Case AscW("0") To AscW("9")
                lHex = (lAsc1 - AscW("0")) * 16
            Case AscW("A") To AscW("F")
                lHex = ((lAsc1 - AscW("A")) + 10) * 16
            Case AscW("a") To AscW("f")
                lHex = ((lAsc1 - AscW("a")) + 10) * 16
            Case Else
                MayBeHex = False
            End Select
            
            lAsc2 = AscW(Mid$(SerialNumber, i + 1, 1))
            Select Case lAsc2
            Case AscW("0") To AscW("9")
                lHex = (lAsc2 - AscW("0")) + lHex
            Case AscW("A") To AscW("F")
                lHex = ((lAsc2 - AscW("A")) + 10) + lHex
            Case AscW("a") To AscW("f")
                lHex = ((lAsc2 - AscW("a")) + 10) + lHex
            Case Else
                MayBeHex = False
            End Select
        
            Select Case lHex
            Case 0 To 31
                InHex = InHex + Chr$(lHex)
            Case 32 To 127
                InHex = InHex + Chr$(lHex)
            Case Else
                MayBeHex = False
            End Select
        
        Next i

        If Not MayBeHex Then
            Convert = SerialNumber
        Else
            InHex = Trim(InHex)
            For i = 1 To Len(InHex) - 1 Step 2
                lAsc1 = AscW(Mid$(InHex, i, 1))
                lAsc2 = AscW(Mid$(InHex, i + 1, 1))
                Mid$(InHex, i, 1) = Chr$(lAsc2)
                Mid$(InHex, i + 1, 1) = Chr$(lAsc1)
            Next i
            For i = 1 To Len(InHex)
                If Mid$(InHex, i, 1) = vbNullChar Then
                    Mid$(InHex, i, 1) = " "
                End If
            Next i
'final check for printable characters
            For i = 1 To Len(InHex)
                Select Case AscW(Mid$(InHex, i, 1))
                Case 0:         Mid$(InHex, i, 1) = " "
                Case 1 To 31:   Mid$(InHex, i, 1) = "."
                Case Else
                End Select
            Next i
            InHex = Trim(InHex)
            Convert = InHex
        End If
    End If
    Exit Function 
EH:
    Resume Next
End Function
This converted a serial number into ID: 3353325a424e4b31324136393332204c20202020 into SerialNumber -> S3Z2NB1KA29623L
I have then simplified and cleaned it up.