Excel - Obtener Num Serie del Disco Duro

   
Vista:

Obtener Num Serie del Disco Duro

Publicado por Jose Gpe Sanz (75 intervenciones) el 28/09/2009 19:52:30
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.
alguien me puede indicar que se le cambia para que funcione 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
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder