Jump to content

Saber el Numero de Serie del Disco Duro


josemaria

Recommended Posts

No se si sera de utilidad o no , pero me lo he encontrado en la biblioteca que tengo, que estoy liado con lo de saber el nombre de los equipos de una red y a aparecido esto. Repito que no es mio.



Sub NroSerieDisco()
Dim fs, d, s, t, drvpath
drvpath = "C"
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
Select Case d.DriveType
Case 0: t = "Desconocido"
Case 1: t = "Separable"
Case 2: t = "Fijo"
Case 3: t = "Red"
Case 4: t = "CD-ROM"
Case 5: t = "Disco RAM "
End Select
s = "Unidad " & d.DriveLetter & ": - " & t
s = s & vbCrLf & "NS: " & d.SerialNumber
MsgBox s
End Sub[/CODE]

Un Saludo.

Jose Maria.

Link to comment
Share on other sites

Hola{

Como curiosidad esta bien, no lo he probado ni 1 minuto pero ponga lo que ponga en drvpath = "C" me da exactamente el mismo resultado, drvpath = "Hola que tal :)",

Pongas lo que pongas, te devuelve la informacion de la unidad en la que esta guardado el archivo, gracias a lo cual me he dado cuenta que al abrir un archivo nuevo excel, mientras se llama Libro1 sin ser guardado (donde he pegado la macro), me ha devuelto la informacion de D en lugar de C, por lo que ahora ya se que cuando creo un archivo, se crea primero en temporal D (en mi PC en concreto).

}Saludos!

Link to comment
Share on other sites

Hola verzulsan, el resultado que obtienes es por el comportamiento de la funcion fs.GetAbsolutePathName el cual es causado por el argumento que le estas pasando.

prueba este ejemplo

Sub test()
drvpath = "C"
Set fs = CreateObject("Scripting.FileSystemObject")
MsgBox "Directorio activo" & vbNewLine & CurDir
MsgBox "GetAbsolutePathName pasandole como argumento " & drvpath & vbNewLine & fs.GetAbsolutePathName(drvpath)

Set fs = Nothing
End Sub[/CODE]

y luego asi

[CODE]Sub test()
drvpath = "Hola que tal"
Set fs = CreateObject("Scripting.FileSystemObject")
MsgBox "Directorio activo" & vbNewLine & CurDir
MsgBox "GetAbsolutePathName pasandole como argumento " & drvpath & vbNewLine & fs.GetAbsolutePathName(drvpath)

Set fs = Nothing
End Sub[/CODE]

y por aca esta explicado el comportamiento

GetAbsolutePathName Method

saludos cordiales

Link to comment
Share on other sites

Hola Never!,

Gracias por la explicacion, vista la funcion en el link que has pasado, lo que hace es sacar con el GetAbsolutePathName la ubicacion absoluta en donde esta localizado el archivo, por eso la variable que comentaba no tiene demasiado sentido, es anulada por GetAbsolutePathName.

Un saludo amigo ;)

Link to comment
Share on other sites

  • Crear macros Excel

  • Posts

    • Muchas gracias! Voy a tener que revisar las macros porque no domino mucho...   Saludos!
    • Sube tu archivo siempre y pon un ejemplo de donde hay que tomar los datos y donde y como deben reflejarse  
    • Hola nuevamente muchachos. Espero estén bien todos, es mi mayor deseo. Estoy teniendo otro problema por acá con la configuración de un TextBox donde quiero expresar números. Propiamente el número que va a estar reflejado en esos TextBox son la división del Salario Mensual entre los días a trabajar y eso me da un índice o tarifa salarial diaria.  No tengo problemas en las operaciones matemáticas, sino en el formato a expresar en el TextBox.  Este dato lo toma el TextBox de la Hoja, la que tengo configurada (Celda) como Numero. Podrían ayudarme. Gracias de antemano y excelente semana para todos. Saludos Pino
    • Buenas tardes. Tengo el siguiente código en una macro:   Sub Prueba() hora = Hour(Now) If hora <= 18 & Sheets("Hoja1").Range("G7") = 1 Then     MsgBox ("haz esto")      ElseIf hora > 18 & Sheets("Hoja1").Range("G7") = 2 Then     MsgBox ("haz esto otro")      Else     MsgBox ("No se cumple") End If End Sub Sin embargo,  siempre se me ejecuta el Else aunque a priori se cumplan las condiciones del If. Adjunto el excel de prueba. ¿Alguna idea del por qué no entra en el If ni en el ElseIf? Gracias   Prueba.xlsm
  • Recently Browsing

    • No registered users viewing this page.
×
×
  • Create New...

Important Information

Privacy Policy