The principles are simple enough. Create a workbook with a header row and three columns
Workbook.png
Save it to the location in the macro with the name in the macro. Run the macro to complete the next entry in the worksheet Sheet1. You should be able to modify the code to fit your brief.
Option Explicit
Sub Macro1()
'Graham Mayor - www.gmayor.com
Const strPath As String = "C:\Path\"
Const strWorkBook As String = "Review Log.xlsx"
Dim strItem As String
Dim oFSO As Object
Dim strValues As String
strItem = "Review Item" 'the item you wish to record
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FileExists(strPath & strWorkBook) Then
MsgBox "The workbook " & strWorkBook & " doesn't exist at " & strPath
GoTo lbl_Exit
End If
strValues = Format(Date, "Short Date") & "', '" & strItem & "', '" & Environ("UserName")
WriteToWorksheet strWorkBook:=strPath & strWorkBook, strRange:="Sheet1", strValues:=strValues
lbl_Exit:
Exit Sub
End Sub
Private Function WriteToWorksheet(strWorkBook As String, _
strRange As String, _
strValues As String)
'Graham Mayor - www.gmayor.com
Dim ConnectionString As String
Dim strSQL As String
Dim CN As Object
ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkBook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
Set CN = CreateObject("ADODB.Connection")
Call CN.Open(ConnectionString)
Call CN.Execute(strSQL, , 1 Or 128)
CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function