Saludos amigos del foro, en el andar viendo el modo de abrir un archivo solo en una máquina, me encontré con una solución interesante, funciona con el artificio en la Hoja1. Le hice unos pequeños cambios, por la hoja3 y otras cosas más..

No obstante, cierro y trato de abrirlo,...... ya no se abre pese a ser la misma máquina, no obstante me sale el mensaje msgbox  programado...

Intente detener la macro con la famosa tecla shift pero aun no logro que ese truco me funcione..

Envío el archivo, si ustedes lo abren y pueden ver el código, algo no estoy haciendo bien con lo de la tecla shift. Si el codigo esta bien, entonces la macro no funciona para el propósito. Si abre sin usar la tecla shift la macro no funciona. Si no lo abren la macro está bien,..no obstante algo debe estar mal pues en mi propia máquina no logro volver a abrirlo.

Me gustaria que lo revisen a ver que ocurre, que habré escrito mal, pues no logro abrirlo por ningún modo

Gracias anticipadas

CONTROL RECONOCIMIENTO DE COMPUTADOR.xlsm

Editado el el 24 de mayo5 años por Visor

Ficha programador\Código\Seguridad macros: Deshabilitar todas las macros y si te lo quieres ahorrar:

Private Sub Workbook_Open()
Dim ruta As String
Hoja3.Unprotect
Hoja3.Range("A1000000") = "C:\"

ruta = Hoja3.Range("A1000000").Text
If Hoja3.Range("B1000000") = "" Then
Hoja1.Range("B1000000") = DiskVolumeId(ruta)

End If

If Hoja3.Range("B1000000") <> DiskVolumeId(ruta) Then
Application.Visible = False
MsgBox "El número de disco no corresponde al Token de la aplicación", , "Error: Número de serie no coincide"
ThisWorkbook.Saved = True
ThisWorkbook.Close
End If
Hoja3.Range("A1").Select
Hoja3.Protect
UserForm1.Show
End Sub

Function DiskVolumeId(Drive As String) As String
Dim sTemp As String
Dim iPos As Long
iPos = InStr(1, Drive, ":")
Drive = IIf(iPos > 0, Left(Drive, iPos), Drive & ":")
sTemp = Hex(CreateObject("Scripting.FileSystemObject") _
.Drives.Item(CStr(Drive)).SerialNumber)
DiskVolumeId = Left(sTemp, 4) & "-" & Right(sTemp, 4)
End Function

 

Hola a todos, tu archivo no abre porque tienes que tienes que colocar el numero de serie de tu disco C en la hojas.

CONTROL RECONOCIMIENTO DE COMPUTADOR.xlsm

Hola Rolano, que gusto saludarte.

Yo he entendido que simplemente quería acceder al código.

Además, tiene un poco de lío con las hojas

If Hoja3.Range("B1000000") = "" Then
   Hoja1.Range("B1000000") = DiskVolumeId(ruta) '¿Es correcto?
End If

Hola Antoni un gusto saludarte, allí debería ser hoja3 y no hoja1, ahora lo que hice es poner manualmente el numero de serie disco C en la hoja3 celda Range("B100000").

Gracias, muchas gracias, efectivamente, se concluye que la macro tal como lo encontré si funciona, he cometido el tremendo error de haber dejado Hoja1 en el código, tal como lo muestra Antoni,...y claro efectivamente ese código lo requería otra vez  pues era el único archivo en el que lo tenía...Gracias Antoni y Gracias Rolano. con esto he recuperado aqui el codigo. El codigo si funciona, el error lo he cometido yo mismo.

Por otro lado

"Ficha programador\Código\Seguridad macros: Deshabilitar todas las macros y si te lo quieres ahorrar:"

Esto si lo hice, está en: Opciones\centro de confianza\Configuración del centro de confianza\configuración de macros\Deshabilitar todas las macros --- lo selecciono y listo,..pero nada!! ----  también manteniendo pulsado Shift pero no lograba nada, el archivo luego del mensaje, se desaparecía incluso juntos con otros abiertos,..en la ventana de código vba no se mostraba lo del archivo problema...Por eso No lograba colocar manualmente el número de serie

Puedo seguir pensando que en mi caso no funciona ese truco, y para futuro me queda el problema de yo miso solucionar romper la macro y recuperar mi codigo. Afortunadamente en ese archivo lo estaba usando como prueba, hubiese sido para mi, desafortunado si lo habria hecho en el archivo con la informacion completa.

Gracias por ayudarme en solucionar este tema

Editado el el 24 de mayo5 años por Visor