Excel - Num Serie Disco Duro

Saludos


http://hojas-de-calculo-en-excel.blogspot.com/2008/05/leer-el-nmero-de-serie-de-los-discos.html
en esta pagina esta publicado un programa para obtener el num de serie del disco duro,
me funciona muy bien en excel 2003, pero en excel 2007 no.
alguien me pude decir que cambiarle o tiene uno para exel 2007.



Gracias

Private Const cID = "3A171608"

Private Declare Function apiGetVolumeInformation 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

Function CheckIDDrv() As Boolean
Dim DrvSerialNo&
Dim DrvLabel As String * 256
Dim FileSys As String * 256
Dim i&, j&, x&

x = apiGetVolumeInformation("C:\", DrvLabel, 256, DrvSerialNo, i, j, FileSys, 256)

If x <> 0 And cID = Hex(DrvSerialNo) Then
CheckIDDrv = True
Else
CheckIDDrv = False
End If
End Function

Saludos, desde Baires, JuanC

Saludos a todos

http://hojas-de-calculo-en-excel.blogspot.com/2008/05/leer-el-nmero-de-serie-de-los-discos.html

Volviendo al mismo tema por no haberme explicado bien
en esta pagina esta publicado el siguiente programa, es para obtener automaticamente el numero de serie del disco duro y asi se proteger los trabajos para que no se copien a otra PC.

si lo RUN en excel 2003 si funciona pone el numero de sierie en la hoja3.
hasta aqui todo bien.

pero si lo RUN en excel 2007 no funciona solo indica si tienes puesto una USB.
Podrias indicarme que se le cambia para RUN en excel 2007

Private Sub Workbook_Open()
'Desactivamos las teclas de cancelación de macros
Application.EnableCancelKey = xlDisabled
'Ocultamos el procedimiento
Application.ScreenUpdating = False
'Mostramos la Hoja3
Hoja3.Visible = xlSheetVisible
'omitimos los mensajes de aviso
Application.DisplayAlerts = False
'Seleccionamos la hoja3
Hoja3.Select
'Selecionamos la celda A1
Range("A1").Select
'Informamos del número máximo de ordenadores
'donde se puede ejecutar la aplicación
maximo_de_ordenadores = 5
'Empezamos...
Set oWMI = GetObject("WINMGMTS:")
Set Discos = oWMI.instancesof("Win32_PhysicalMedia")
'Para el conjunto de discos de ese PC...
For Each Disco In Discos
'leemos el número de serie, eliminando
'previamente los espacios vacios del
'principio y del final del número de serie
numero_de_serie = Trim(Disco.serialnumber)
'si no tiene número de serie (como las
'memorias flash, por ejemplo), que
'ponga: "Memoria flash o similar"
If IsNull(numero_de_serie) Then numero_de_serie = "Memoria flash o similar"
'y lo escribimos a partir de la primera
'celda vacía que encontremos, siempre
'y cuando no tengamos registrado ya ese
'número de serie del disco
Do While Not IsEmpty(ActiveCell)
'comprobamos si el valor de la celda
'es igual o no al número de serie del disco
'duro que estamos leyendo en este momento
If ActiveCell <> Trim(numero_de_serie) Then
'Si es distinto, bajamos a la fila siguiente
ActiveCell.Offset(1, 0).Select
Else
'Si es igual, entonces finalizamos el macro
'pero antes ocultamos la Hoja3 al máximo
Hoja3.Visible = xlSheetVeryHidden
'Grabamos el fichero
ThisWorkbook.Save
'finalizamos el macro
Exit Sub
End If
Loop
ActiveCell = numero_de_serie
'pasamos a la siguiente fila
ActiveCell.Offset(1, 0).Select
Next
Set Disco = Nothing
Set Discos = Nothing
Set oWMI = Nothing
'ponemos en B1 el número de ordenador en el
'que se ha ejecutado la aplicación, controlando
'que no se pase del límite máximo
'limpiamos los objetos
If Range("B1") = "" Then
Range("B1") = 1
'Grabamos el fichero
ThisWorkbook.Save
Else
If Range("B1") < maximo_de_ordenadores Then
'Sumamos 1 al valor que haya
Range("B1") = Range("B1") + 1
'Grabamos el fichero
ThisWorkbook.Save
Else
'Cerramos el libro, porque habrá
'llegado al máximo permitido
ThisWorkbook.Close
End If
End If
'Volvemos a mostrar los mensajes de aviso
Application.DisplayAlerts = True
'Ocultamos la Hoja3 al máximo
Hoja3.Visible = xlSheetVeryHidden
'Seleccionamos la Hoja1
Hoja1.Select
'Mostramos el procedimiento
Application.ScreenUpdating = True
End Sub

Sub Mostrar_hoja3()
'Mostramos la Hoja3
Hoja3.Visible = xlSheetVisible
End Sub

Sub Ocultar_hoja3()
'Mostramos la Hoja3
Hoja3.Visible = xlSheetVeryHidden
End Sub

Gracias

Felicitaciones.
Gracias!!!!