Para DAM, Macro que divida celda en varias, separando fecha y frase

H o l a:

Ya no veo la pregunta del número de serie del disco.

Te respondo en esta.

Ejecuta la siguiente para ver si es lo que necesitas cambia "C" por la unidad que desee.

Sub seriedisco()
    With CreateObject("Scripting.FileSystemObject")
        MsgBox "Número de serie " & Hex(.Drives.Item("C:").SerialNumber)
    End With
End Sub

':)
S a l u d o s . D a n t e   A m o r
':) Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.

DAM, primero que todo muchas gracias por tomarte el tiempo de responder; la verdad no se que sucedió, tampoco la encuentro, si necesitas que repita la pregunta lo hago o si prefieres continuar en ésta me avisas por favor.

Te cuento que no es lo que necesito, pues si ejecutas la primera o sea ésta:

Sub Unidad_Fisica()
  Dim Disco As Object
  With GetObject("WinMgmts:")
    For Each Disco In .instancesof("Win32_PhysicalMedia")
         MsgBox "Serie de Fábrica: " & Application.Trim(Disco.serialnumber)
    Next
  End With
End Sub

Si la ejecutas, lo hace a todos los discos de mi computador y para el Disco Duro me da el siguiente resultado:

S17AJ9CS611922

Con ésta que tengo, me serviría, el único inconveniente es que por el Bucle For Each me la realiza a todos los discos.

Tengo ésta otra:

Sub MostrarInfoDrive()
    Dim fs, d, s, t
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
    drvpath = ThisWorkbook.Path
    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 & "Número: " & d.serialnumber
    MsgBox s
End Sub

que me la ejecuta a la Unidad sea C, D, H u otra, pero me extrae el siguiente resultado:

"Unidad C: -Fijo
Número: 1415592640 "

Pero ese número de identificación cambiaría si se hace necesario Formatear la Unidad.

Conclusión:

Requiero la primera pero que no me la ejecute en todos los discos, si no únicamente dónde tengo instalado el Libro de Excel.

Saludos.

Seguimos con esta.

¿Qué te regresa la macro que te envié?

La macro que pusiste del bucle no me funciona, a de ser por mi versión de excel.

Hola, la Macro que me aportas me arroja el siguiente resultado:

Número de serie 54603AC0

Dam, la macro la obtuve si no estoy mal de éste tema, es solo que la sentencia me funciona, el tema fue planteado en el año 2.007 y tengo Excel 2010.

https://groups.google.com/forum/#!topic/microsoft.public.es.excel/8-ikY6vva00

Sigo revisando haber si encuentro algo que me funcione y te lo envío.

Dam, para que sepas exactamente el número de serie que se debe extraer de tu computador, en la consola de Windows de tu equipo deberás en el cuadro de ejecutar escribir "cmd" y en la consola escribirás:  

WMIC DISKDRIVE GET SERIALNUMBER

Allí te reportará los seriales suministrados por los fabricantes de cada uno de los discos de tu computador, esa sería la prueba para obtener el número requerido.

Esta macro está bien, es solo que la modificación a efectuarse es que no se haga a todos los discos, si no a uno en particular.

Sub Unidad_Fisica()
  Dim Disco As Object
  With GetObject("WinMgmts:")
    For Each Disco In .instancesof("Win32_PhysicalMedia")
         MsgBox "Serie de Fábrica: " & Application.Trim(Disco.serialnumber)
    Next
  End With
End Sub

Es entonces necesario el efectuar la modificación únicamente creo en el Bucle For Each correspondiente.

Espero que no me olvides.

Saludos.

H o l a:

Ejecuta la siguiente macro en una hoja nueva:

Sub verp()
'referencia: http://www.vbforums.com/showthread.php?356399-RESOLVED-Problem-with-Win32_PhysicalMedia-WMI
    Dim prop
    Set pms = GetObject("winmgmts:{impersonationLevel=impersonate}").instancesof("Win32_PhysicalMedia")
    i = 1
    For Each pm In pms
        For Each prop In pm.Properties_
            Cells(i, "A") = prop.Name
            Cells(i, "B") = prop.Value
            i = i + 1
        Next prop
    Next
End Sub

Dime cuál es el resultado.

Ejecuta la siguiente macro en una hoja nueva:

Sub ver_Datos()
'referencia: http://www.vbforums.com/showthread.php?356399-RESOLVED-Problem-with-Win32_PhysicalMedia-WMI
    Dim prop
    Set pms = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_DiskDrive")
    i = 1
    Columns("A:D").ClearContents
    For Each pm In pms
        For Each prop In pm.Properties_
            Cells(i, "A") = prop.Name
            Cells(i, "B") = prop.Value
            i = i + 1
        Next prop
    Next
    '
    Set pms = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_PhysicalMedia")
    i = 1
    For Each pm In pms
        For Each prop In pm.Properties_
            Cells(i, "C") = prop.Name
            Cells(i, "D") = prop.Value
            i = i + 1
        Next prop
    Next
End Sub

Lo que hace es listar las propiedades de "Win32_DiskDrive" y "Win32_PhysicalMedia"; lo que entiendo es que te muestra todas las propiedades de computador.

Revisa el resultado y dime cuál es el dato que necesitas.

Sal u dos

Dam, Hola nuevamente y muchas gracias por toda la dedicación que estás empleando en ayudarme.

De la primera Macro que propones el resultado obtenido es el siguiente:

Capacity

Caption

CleanerMedia

CreationClassName

Description

HotSwappable

InstallDate

Manufacturer

MediaDescription

MediaType

Model

Name

OtherIdentifyingInfo

PartNumber

PoweredOn

Removable

Replaceable

SerialNumber                         S17AJ9CS611922     

SKUStatusTag                          \\.\PHYSICALDRIVE0

Version

WriteProtectOn

Capacity

Caption

CleanerMedia

CreationClassName

Description

HotSwappable

InstallDate

Manufacturer

MediaDescription

MediaType

Model

Name

OtherIdentifyingInfo

PartNumber

PoweredOn

Removable

Replaceable

SerialNumber                         1181     

SKUStatusTag                          \\.\PHYSICALDRIVE1

Version

WriteProtectOn

Y así se me sigue reportando para cada uno de los 4 Dispositivos o Unidades.

Y de la segunda Macro al ejecutarla, al igual que la primera el dato que me interesa obtener es:

El número que espero obtener es el que corresponde a "SerialNumber",

Pero solo de la Unidad donde tengo guardado el archivo de excel, o sea lo que equivaldría a "ThisWoorkbook.Path"; es por ello que te insisto que se debe modificar lo referente al Bucle "For ...  Each ...  Next"

Saludos y continúo atento.

Lo que veo en tu resultado es que el primer disco tiene el número de serie que necesitas, eso era lo que quería ver.

Prueba con lo siguiente, en la variable "miserie" se almacena tu número de serie.

Sub Unidad_Fisica()
    Dim Disco As Object
    With GetObject("WinMgmts:")
        For Each Disco In .instancesof("Win32_PhysicalMedia")
            miserie = Application.Trim(Disco.serialnumber)
            MsgBox "Serie de Fábrica: " & miserie
            Exit For
        Next
    End With
End Sub

Sal u dos

Dam, muchas gracias por tu respuesta y veo que a pesar de todos los inconvenientes puestos no me has abandonado.

Si la macro que me acabas de aportar la ejecuto desde un archivo que tengo en mi Disco Duro, estupendo, pero si la ejecuto desde una de mis memorias USB me sigue dando el mismo número de Serie del Duro, pero no el de la USB.

Fíjate por favor con atención, que eso es lo que siempre te he resaltado:

"Pero solo de la Unidad donde tengo guardado el archivo de excel, o sea lo que equivaldría a "ThisWoorkbook.Path"; es por ello que te insisto que se debe modificar lo referente al Bucle "For ...  Each ...  Next""

Quedo atento.

Saludos.

H o l a:

Ya entendí que se debe realizar el control en el For Next, no tienes que decírmelo a cada momento.

Pero debemos identificar de todos los registros que están en el ciclo cuál es el que requieres.

Por eso estoy investigando qué datos están en el ciclo.

Te pedí que ejecutaras esta macro y que me enviaras los resultados.

Sub ver_Datos()
'referencia: http://www.vbforums.com/showthread.php?356399-RESOLVED-Problem-with-Win32_PhysicalMedia-WMI
    Dim prop
    Set pms = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_DiskDrive")
    i = 1
    Columns("A:D").ClearContents
    For Each pm In pms
        For Each prop In pm.Properties_
            Cells(i, "A") = prop.Name
            Cells(i, "B") = prop.Value
            i = i + 1
        Next prop
    Next
    '
    Set pms = GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("Win32_PhysicalMedia")
    i = 1
    For Each pm In pms
        For Each prop In pm.Properties_
            Cells(i, "C") = prop.Name
            Cells(i, "D") = prop.Value
            i = i + 1
        Next prop
    Next
End Sub

Los resultados te los pone en las columnas A, B, C y D. De esos datos debes identificar la información que requieres.

Hola DAM, primero que todo deseo pedirte disculpas, por si en algún momento te a parecido que mi intención es ser molesto en mis comentarios.

Retomando nuevamente el tema te digo lo ya dicho anteriormente, cuando me proponías hacer la prueba con las dos macros:

" Y así se me sigue reportando para cada uno de los 4 Dispositivos o Unidades.

Y de la segunda Macro al ejecutarla, al igual que la primera el dato que me interesa obtener es:

El número que espero obtener es el que corresponde a "SerialNumber","

en conclusión:

• De ambas macros el único dato que necesito obtener es el que da frente a "SerialNumber", pero únicamente el de la Unidad Física donde se encuentra guardado el libro de trabajo.

Saludos.

Ya sé que el dato que necesitas es el serialNumber NO me lo tienes que repetir a cada momento, pero la macro no distingue desde cuál disco se está ejecutando. Ya que el resultado lo obtiene de los datos de la máquina y no de los datos de la macro.

Por eso, ejecuta la macro y tendrás en las columnas A, B, C y D toda la información que tienes de la máquina, ahí investiga cuál es lo que necesitas.

Sal u dos

¡Gracias!, veo que no se obtuvo solución a lo solicitado, más sin embargo muchas gracias por tu tiempo y dedicación, entonces seguiré trabajando en base a la macro que tengo desde un principio:

Sub Unidad_Fisica()
  Dim Disco As Object
  With GetObject("WinMgmts:")
    For Each Disco In .instancesof("Win32_PhysicalMedia")
         MsgBox "Serie de Fábrica: " & Application.Trim(Disco.serialnumber)
    Next
  End With
End Sub

, que por lo menos me reporta la información requerida y no una serie de información que para otros casos sean bastante útiles, pero para la presente carecen de utilidad.