Access y VBA
Blog de Access y VBA del Buho


Inicio


Acerca de
Suscríbete al blog

Categorías
General [3] Sindicar categoría
Access con Codigo VBA [15] Sindicar categoría

Archivos
Septiembre 2005 [11]
Agosto 2005 [5]
Junio 2005 [2]

Sindicación (RSS)
Artículos
Comentarios

 


Impedir abrir Form si otro está abierto

Esta función impide abrir un formulario mientras otro usuario este usando ese (u otro) formulario, en un entorno FrontEnd / BackEnd

Uso:

Private Sub Form_Open(Cancel As Integer)
If Not AWformUnico() Then
    Cancel = True
    Exit Sub
End If
'...
End Sub

'******************************

'* Marcar en referencias:

'* Microsoft DAO 3.x

'* Windows Script Host Object Model (wshom.ocx)

'*

'* Si no usamos WSHOM borrar las lineas  'referencia a wshom

'* (Esta funcion debe incluirse dentro del modulo del Form) '

'*

'* ******************************

Private Function AWformUnico() 

  Static dbsUnico As DAO.Database 

  Dim tbl As DAO.TableDef, dbs As DAO.Database 

  Dim AWrutaDb, AWconnectDb, AWrutaDbForm, usrName 

  Dim shellTMP As New IWshNetwork_Class 'referencia a wshom

  On Error GoTo errorAWformUnico

  For Each tbl In CurrentDb.TableDefs 

    If tbl.Connect > "" Then 

      AWrutaDb = Mid(tbl.Connect, InStr(tbl.Connect, "DATABASE=") + 9) 

      AWconnectDb = Left(tbl.Connect, InStr(tbl.Connect, "DATABASE=") - 2) 

      AWrutaDbForm = Left(AWrutaDb, InStrRev(AWrutaDb, "\")) & "DbForm.mdb" 

      If Dir(AWrutaDbForm) = "" Then 

        DBEngine.Workspaces(0).CreateDatabase AWrutaDbForm, dbLangGeneral 

      End If 

      Set dbs = OpenDatabase(AWrutaDb, False, False, AWconnectDb) 

      Set dbsUnico = OpenDatabase(AWrutaDbForm, True, False)

      On Error Resume Next

      dbs.Properties.Delete "DbForm" 

      usrName = CurrentUser 

      usrName = usrName & " (" & shellTMP.ComputerName & "/" & hellTMP.UserName & ")"

      ' linea superior, referencia a wshom 

      On Error GoTo errorAWformUnico 

      dbs.Properties.Append dbs.CreateProperty("DbForm", DB_TEXT, usrName) 

      dbs.Close 

      Exit For 

    End If 

  Next 

  AWformUnico = True 

AWformUnicoExit: 

  Set dbs = Nothing 

  Exit Function 

 

errorAWformUnico:

  If Err.Number = 3045 Then 

    MsgBox "En este momento " & dbs.Properties("DbForm").Value & vbNewLine _ 

    & "esta usando este formulario. " & vbNewLine & vbNewLine & "Intentelo mas tarde." _ 

    , vbInformation, "No puede abrir " & Me.Caption

    AWformUnico = False 

  Else 

    MsgBox Err.Description 

  End If 

  Resume AWformUnicoExit

End Function

Por ErBuho - 5 de Septiembre, 2005, 1:27, Categoría: Access con Codigo VBA
Enlace Permanente | Referencias (0)




<<   Septiembre 2005    
LMMiJVSD
      1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30   

Enlaces
eGrupos
ZoomBlog

 

Blog alojado en ZoomBlog.com