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 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 así que meto esta 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 Juan, esta para que la pruebes en una ADP+SqlServer a ver si funciona Sub PruebaJuan() Dim sql As String, rst As ADODB.Recordset sql = "select * from master.dbo.sysprocesses where Spid=51" Dim Con As ADODB.Connection Set Con = Application.CurrentProject.Connection Set rst = New ADODB.Recordset With rst Set .ActiveConnection = CurrentProject.Connection .Source = sql .CursorLocation = adUseServer .CursorType = adOpenKeyset .LockType = adLockOptimistic .Open End With If rst.EOF = False Then MsgBox Trim(Replace(rst!hostname, vbNullChar, "")) Else MsgBox "No funciona" End If rst.Close Set rst = Nothing End Sub