VBA Excel - Acrescentando registro em MS Access.

Para acrescentar um registro a uma base de dados MS Access, precisa assegurar-se de que o seu MS Excel está configurado com a referência a biblioteca DAO:

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