Getting Username details from word into excel

HI, In my line of work the people under me are supposed to read daily updates in MS Word and acknowledge having read that. I want a code in Word where each user should click the topic under review and acknowledge it and his log in user name should be captured in a excel file. I would like the topic that was clicked and the username to get captured. I tried searching the net a lot for the ms word coding but could not get too much on this and hence finally I reached out to the grp.

Appreciate any assistance to make life simpler.

The principles are simple enough. Create a workbook with a header row and three columns

Attachment 16221
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.

Code:

---

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

---

Sorry in the delayed response. Firstly thank you for taking out time but few clarifications on the above. The party part of the text which has been hardcoded,is there a way that the user selects it that gets captured. The review item bit. ( stritem)

The macroi shows merely the method of getting the value into Excel. It doesn't address getting it from the document as I have not seen that. However the following modification will record the paragraph that the cursor is in, provided it is formatted with one of Word's heading styles (as an error check). It assumes that you have used heading styles for your headings.

Code:

---

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
Dim oPara As Range
    Set oPara = Selection.Paragraphs(1).Range
    oPara.End = oPara.End - 1
    If oPara.Style Like "Heading*" Then
        strItem = oPara.Text
        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
    Else
        MsgBox "Select the heading paragraph first!"
    End If
lbl_Exit:
    Exit Sub
End Sub

---