VBA - Contador de Acessos

Na empresa criou a necessidade de saber com que frequencia as pessoas acessavam alguns arquivos, reports, entre outros; para saber até onde era importante ficar perdendo tempo e espaço na rede com tais. Ai criei a seguinte macro para tal.

Obs.: Tudo deve ser feito dentro do mesmo módulo.

Public refacess As Integer

Sub Auto_Open()
'Macro para contar acessos de usuários aos arquivos.

Application.DisplayStatusBar = False

'Declarar variáveis
Dim nome As String
' Nome do arquivo aberto
nome = ThisWorkbook.name

' Abrir arquivo base
Workbooks.Open "G:\Users\Publico Geral\Controlling\cont_acess.xls" 'Crie anteriormente esse arquivo


' Data
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("A1").End(xlDown).Offset(1, 0) = "=NOW()"
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("A1").End(xlDown).Copy
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("A1").End(xlDown).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Hora In
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("B1").End(xlDown).Offset(1, 0) = "=NOW()"
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("B1").End(xlDown).Copy
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("B1").End(xlDown).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Usuário
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("C1").End(xlDown).Offset(1, 0) = VBA.Environ("username")

' Mês
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("D1").End(xlDown).Offset(1, 0) = "=MONTH(RC[-3])"
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("D1").End(xlDown).Copy
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("D1").End(xlDown).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Ano
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("E1").End(xlDown).Offset(1, 0) = "=YEAR(RC[-4])"
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("E1").End(xlDown).Copy
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("E1").End(xlDown).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Arquivo
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("F1").End(xlDown).Offset(1, 0) = nome

refacess = Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("F1").End(xlDown).Row

Workbooks("cont_acess.xls").Save
Workbooks("cont_acess.xls").Close

Application.DisplayStatusBar = True

End Sub

Sub Auto_Close()

If refacess = 0 Then
GoTo Fim
End If

' Abrir arquivo base
Workbooks.Open "G:\Users\Publico Geral\Controlling\cont_acess.xls"
Application.DisplayStatusBar = False

' Hora Out - Total tempo de uso
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("G1").Offset(refacess - 1, 0) = "=NOW()-RC[-5]"
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("G1").Offset(refacess - 1, 0).Copy
Workbooks("cont_acess.xls").Sheets("CONT_ACESS").Range("G1").Offset(refacess - 1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Application.DisplayStatusBar = True
Workbooks("cont_acess.xls").Save
Workbooks("cont_acess.xls").Close


Fim:
End Sub

_____________________

Para o arquivo onde ficará salvo os dados, você pode renomeá-lo, colocar em outro destino, contanto que mude o mesmo nas linhas de código. E o arquivo deve ter a estrutura e formatação como o da imagem acima.

Ali no contator da coluna J, eu apenas fiz uma funçaõ de cont.num().

Esse arquivo tem que ser um arquivo no qual todos os usuários tenham acesso para modificar e salvar. Pois essa a essência do motivo dele ser salvo numa fonte externa. Pois pode ser que a pessoa abra um arquivo mas que esteja protegido, e apenas pode ver como leitura. Colocando a macro, nele mesmo assim, será salvo seu acesso.

Contudo, há o problema de 2 usuários abrir esse arquivo ao mesmo tempo. Em 2 semanas, aqui, isso ainda não aconteceu, visto que a probabilidade desse evento acontecer também é pequena. E serão poucos casos. Mas devido a isso, já estou pensando em fazer um esquema para que isso vá para uma base no Access. Mas por enquanto, vai desse modo mesmo. Contudo, o código está feito para as minhas necessidades, tente adaptar a sua, na medida do possível.