'Crea un módulo nuevo y pega este código. Nombre: basProtegerBDconNumeroHD

Option Compare Database
Option Explicit

'Crea un módulo nuevo y pega este código.

    Declare Function GetVolumeInformation 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
    
    Dim dblx As Boolean
    Dim lpRootPathName As String
    Dim lpVolumeNameBuffer As String
    Dim nVolumeNameSize As Long
    Dim lpVolumeSerialNumber As Long
    Dim lpMaximumComponentLength As Long
    Dim lpFileSystemFlags As Long
    Dim lpFileSystemNameBuffer As String
    Dim nFileSystemNameSize As Long

Sub DemoProtegerBDConNúmeroHD()
'Proteger la MDB contra copias.
'Grupo de noticias: José A. Giménez <jgimenez@conexion.com.py>
'                   msnews.microsoft.com // microsoft.public.es.access
'PREGUNTA: Quiero proteger mi MDB contra copias. He pensado en facilitar un código a partir _
del nº de serie del disco duro donde se encuentra instalado, o algo aseí. Alguna vez ví _
en el foro el código para buscar el nº de volumen del HD, ¿lo tenéis?

    Dim N As Variant

    N = GetVolumeInformation(lpRootPathName, lpVolumeNameBuffer, _
        nVolumeNameSize, lpVolumeSerialNumber, lpMaximumComponentLength, _
        lpFileSystemFlags, lpFileSystemNameBuffer, nFileSystemNameSize) _

    If lpVolumeSerialNumber = 424481242 Then
    'ok es el mismo equipo no se hace nada
    'el 424481242 es el nro de serie de la maquina en dondes está el programa, lo pudes _
    obtener haciendo un msgbox de lpVolumeSerialNumber o bien por medio del chkdsk del DOS _
    que lo 'muestra en hexadecimal
    Else
        MsgBox "La estación no está habilitada para ejecutar el programa. Se cerrará la " _
                & "aplicación", vbCritical, "Error"

   '     DoCmd.Close 'cierra el form
   '     DoCmd.Quit 'Cierra Access
    End If

End Sub