Function GetPhysicalDriveSerialNumber(Optional  ID As Integer = 0,  Optional bSepar  As Boolean = True) As  String
    GetPhysicalDriveSerialNumber = "0000-0000"
    On Local Error Resume Next
    Dim sComputerName$
    sComputerName = Environ$("COMPUTERNAME")
    
    Dim WMI_Obj As Object, WMI_ObjProps As Object, ObjClsItem As  Object
    Set WMI_Obj = GetObject("winmgmts:\\" & sComputerName & "\root\cimv2")
    Set WMI_ObjProps = WMI_Obj.ExecQuery("Select * from Win32_PhysicalMedia", , 48)
    
    Dim sRet As String
    For Each ObjClsItem In WMI_ObjProps
        If ObjClsItem.Tag = "\\.\PHYSICALDRIVE" & CStr(ID) Then
'           ici le serial en  base16 ou 10
            sRet = Trim$(ObjClsItem.SerialNumber)
'           conversion base10
            If Not (LenB(sRet) = 16) Then  sRet = GetBase10FromBase16(sRet)
'           ok, retour
            If bSepar Then
                GetPhysicalDriveSerialNumber = UCase$(LeftB$(sRet, 8) & "-" & RightB$(sRet, 8))
            Else
                GetPhysicalDriveSerialNumber = UCase$(sRet)
            End If
            Exit For
        End If
    Next ObjClsItem
    Set ObjClsItem = Nothing
    Set WMI_ObjProps = Nothing
    Set WMI_Obj = Nothing
End Function
Private Function GetBase10FromBase16(ByVal sStr As String) As String
    Dim i As Integer
    sStr = Replace(sStr, "20", vbNullString)
    GetBase10FromBase16 = Space$(8)
    For i = 1 To 15 Step 2
        Mid$(GetBase10FromBase16, i \ 2 + 1, 1) = Chr$(Val("&H" & Mid$(sStr, i, 2)))
    Next i
End Function

    Function GetPhysicalDriveSerialNumber(Optional ByVal ID As Integer = 0, Optional ByVal bSepar As Boolean = True) As String
    'CETTE FONCTION NéCESSITE :
    '       LA RéFéRENCE 'System.Management'
    '       LA FONCTION 'GetBase10FromBase16'
        'valeur de retour par défaut
        Dim sReturn As String
        If bSepar Then sReturn = "0000-0000" Else sReturn = "00000000"
        Try
            'construction requête WMI
            Dim WMI_Obj As New ManagementObjectSearcher("root\CIMV2", "SELECT * FROM Win32_PhysicalMedia")
            'recherche chaque item
            For Each ObjClsItem As ManagementObject In WMI_Obj.Get()
                'si item = disque recherché
                If (ObjClsItem.GetPropertyValue("Tag").ToString = "\\.\PHYSICALDRIVE" & ID.ToString) Then
                    'ici le serial en base16 ou 10
                    Dim sRet As String = ObjClsItem.GetPropertyValue("SerialNumber").ToString
                    'peut être vide
                    If sRet IsNot Nothing Then
                        'conversion base10
                        sRet = sRet.Trim
                        If Not (sRet.Length = 8) Then sRet = GetBase10FromBase16(sRet)
                        'ajoute le "-" si nécessaire, puis retour en variable
                        If bSepar Then sRet = String.Concat(sRet.Substring(0, 4), "-", sRet.Substring(4))
                        sReturn = sRet.ToUpper
                    End If
                    Exit For
                End If
            Next ObjClsItem
        Catch ex As Exception
        End Try
        'retour fonction
        Return sReturn
    End Function
    Private Function GetBase10FromBase16(ByVal sStr As String) As String
        Dim sReturn As String = String.Empty
        sStr = sStr.Replace("20", String.Empty)
        For i As Integer = 0 To 15 Step 2
            sReturn += Convert.ToChar(Convert.ToInt64(sStr.Substring(i, 2), 16))
        Next i
        Return sReturn
    End Function