Option Compare Database
Option Explicit
Private Declare Function EquipoApi Lib "kernel32" Alias _
    "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long


Function PrevInstanceMono() As Boolean
'esta sería para el supuesto caso de una MDB en un ordenador
'monopuesto y que un usuario no picara dos veces en la misma
'mdb e impedir abrir dos instancias.

Const adhcUsers = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
   Dim RsADO As ADODB.Recordset, Contador As Integer
   Set RsADO = New ADODB.Recordset
   Set RsADO = CurrentProject.Connection.OpenSchema( _
       schema:=adSchemaProviderSpecific, schemaid:=adhcUsers)
   While Not RsADO.EOF = True
    Contador = Contador + 1
    RsADO.MoveNext
   Wend
   RsADO.Close
   Set RsADO = Nothing
   If Contador > 1 Then PrevInstanceMono = True
   
End Function


Function PrevInstanceRed() As Boolean
'esta sería ya la general, como la tuya, para el supuesto caso de una MDB en un ordenador
'en RED para impidir y que un usuario picara dos veces en la misma
'mdb e impedir abrir dos instancias en UN PC CONCRETO de la red.
'No utilizo metodos FIND ni similares, simplemente recorro
'el bucle a pelo, ya que se supone que una MDB no puede tener
'muchos accesos simultaneos. No sirve, claro para los ADP's
'tal y como comentabas ayer :-(

Const adhcUsers = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
   Dim RsADO As ADODB.Recordset, Contador As Integer
   Set RsADO = New ADODB.Recordset
   Set RsADO = CurrentProject.Connection.OpenSchema( _
       schema:=adSchemaProviderSpecific, schemaid:=adhcUsers)
   While Not RsADO.EOF = True
    If Trim(Replace(RsADO!Computer_name, vbNullChar, _
        "")) = DameEquipoWSH() Then
     Contador = Contador + 1
    End If
    RsADO.MoveNext
   Wend
   RsADO.Close
   Set RsADO = Nothing
   If Contador > 1 Then PrevInstanceRed = True
   
End Function

'*********************************************************************************
'Aqui, por recordar, que viene bien siempre, pongo los diferenets sistemas que
'conozco para sacar el nombre del equipo en RED.
'*********************************************************************************

'Hay varios sistemas para saber el nombre del equipo que corre en esta maquina.
'Si uso Environ,no funciona en sistema Windows < XP
Private Function DameEquipoEnviron() As String
 DameEquipoEnviron = Environ("COMPUTERNAME")
End Function

'Esta funcionará en equipos Win98 en adelante, no creo que haya
'alguna antiguaya con Win 95
Private Function DameEquipoWSH() As String
  Dim ObjetoRed As Object
  Set ObjetoRed = CreateObject("WScript.Network")
  DameEquipoWSH = ObjetoRed.Computername
  Set ObjetoRed = Nothing
End Function

'Aqui la API...pero tengo la misma duda, si en Win 95 existe esta API o no.
'Y es que manda guevos con las versiones !!!!
Private Function DameEquipoApi() As String
    Dim Devuelve As String
    Devuelve = String(255, Chr$(0))
    EquipoApi Devuelve, 255
    DameEquipoApi = Left$(Devuelve, InStr(1, Devuelve, Chr$(0)) - 1)
End Function