Macro to Record users have read a document - vba

Question

Apologies if this is answered somewhere else, but i have searched and couldn't find anything.
I have been asked to create a way of tracking when users have read our policy documents and recording it. My initial thoughts were to have a macro button at the bottom of the policy document (in word) which the user clicks to confirm they have read it. This would then update a Excel spreadsheet, which would then insert a new line capturing the users name, the document name and a timestamp.
The team can then view who has read what etc. and delete the excel lines once they are up to date. The excel would of course be saved in a static location.
Unfortunately, my VB skills are pretty minimal, so i wouldn't know where to start. Can this be done? Can anyone help?

Answer 1

You could try below
Sub save_tracking()
Dim XLapp As Excel.Application
Dim xlWB As Excel.Workbook
Set XLapp = New Excel.Application
'turn off extra bits
Screen_ = XLapp.ScreenUpdating
XLapp.ScreenUpdating = False
Event_ = XLapp.EnableEvents
XLapp.EnableEvents = False
Alerts_ = XLapp.DisplayAlerts
XLapp.DisplayAlerts = False
'get username
un = Environ("username")
'open tracking workbook
Set xlWB = XLapp.Workbooks.Open("C:\Test Tacking.xlsx", False, False)
'save information
With xlWB.Sheets(1)
If .Range("A2").Value = "" Then
'no values yet
.Range("A2").Value = un
.Range("B2").Value = XLapp.Name
.Range("C2").Value = Now()
ElseIf .Range("A3").Value = "" Then
'2nd
.Range("A3").Value = un
.Range("B3").Value = XLapp.Name
.Range("C3").Value = Now()
Else
'>2 values
.Range("A2").End(xlDown).Offset(1, 0).Value = un
.Range("B2").End(xlDown).Offset(1, 0).Value = XLapp.Name
.Range("C2").End(xlDown).Offset(1, 0).Value = Now()
End If
End With
'restore settings to previous
XLapp.ScreenUpdating = Screen_
XLapp.EnableEvents = Event_
XLapp.DisplayAlerts = Alerts_
'save/close workbook
xlWB.Close True
XLapp.Quit
Set XLapp = Nothing
End Sub
Function Environ(Expression)
On Error GoTo Err_Environ
Environ = VBA.Environ(Expression)
Exit_Environ:
Exit Function
Err_Environ:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Environ
End Function
Change the filename of xlWB to where your tracking sheet is stored. In the tracking sheet A1/B1/C1 is reserved for a heading and information will be stored in the first sheet.
Edit: Modified to run from another office program. You will need a reference to "Microsoft Excel 12.0 Object Library" the version may be different but that should be ok. Tools --> References. gets you to the references