Microsoft ActiveX Data Objects 6.0 Library
c:\Program Files\Common Files\System\ado\msado15.dll
Microsoft DAO 3.6 Object Library
c:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll
Em seguida execute uma inserção do usuário, com horário e demais dados relevantes (você mesmo deve definir o que acha ser mais apropriado):
Function InsertUserInapplication(nUser As String)
' Author: Date: Contact: URL:
' André Bernardes 22/03/2010 11:56 bernardess@gmail.com http://al-bernardes.sites.uol.com.br/
' Insere o nome do usuário, indicando que este está plugado a aplicação e ativo nela.
Dim nSQL As String
' Sample:
'INSERT INTO tbl_Connected ( ID, [TimeStamp] )
'SELECT '01101304I' AS IDentification, #3/22/2010 14:32:0# AS nTime
'FROM tbl_Sys_Add;
Let nSQL = "INSERT INTO tbl_Connected (ID, [TimeStamp]) " & _
"SELECT '" & nUser & "' AS IDentification, " & _
"#" & nowUserTime & "# AS nTime " & _
"FROM tbl_Sys_Add"
Call StatusUser_AccessData(pth_Base, dbs_Base, nSQL)
End Function
Agora poderá efetuar consultas antes de abrir a planilha para saber se alguém está utilizando sua aplicação.
Quando o usuário terminar de utilizar a planilha, deve deletar o usuário da tabela, e/ou apenas desabilitá-lo em um campo apropriado:
Function DeleteUserInapplication(nUser As String)
' Author: Date: Contact: URL:
' André Bernardes 22/03/2010 14:06 bernardess@gmail.com http://al-bernardes.sites.uol.com.br/
' Deleta o nome do usuário ativo, que está plugado na aplicação.
Dim nSQL As String
Let nSQL = "UPDATE tbl_Connected " & _
"SET tbl_Connected.TimesOut = #" & Now() & "#, " & _
"tbl_Connected.Online = 0 " & _
"WHERE (((tbl_Connected.ID)= '" & nUser & "' ))"
Call StatusUser_AccessData(pth_Base, dbs_Base, nSQL)
End Function
Acessando a base de dados (esta configurado para a versão do Office 2007)
Sub StatusUser_AccessData (nPath As String, nDataBaseName As String, nSQL As String) ' Author: Date: Contact: URL: ' André Bernardes 22/03/2010 12:03 bernardess@gmail.com http://al-bernardes.sites.uol.com.br/ ' Inserindo o usuário ativo na aplicação neste momento.
Dim stDB As String Dim cnt As New ADODB.Connection
Let stDB = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & nPath & nDataBaseName
cnt.Open stDB cnt.Execute nSQL
'Set stDB = Nothing
Set cnt = Nothing
End Sub
