Recording word count

[FrecklePaw]

I had a previous thread where I asked about quickly referencing the word count in a document. It was complicated by the fact I couldn't use the shortcut method (due to the documents being password protected), i.e. Properties > Details > word count (and thus making for easy viewing of the word count within that document without having to open it).

It got me wondering again, is there a/another way to manually extract the data myself once I am finished with a document and need to find out the word count. (I know some of you may say, 'note it down and enter it into a spreadsheet separately'. The problem with this is I tend to forget when I am busy!)

Could I perhaps set up a macro or something similar to automatically pull the data from Word into an Excel spreadsheet?

[HansV]

Would you want the macro to be run automatically when a specific document is saved? Or when any document is saved?

[FrecklePaw]

Would you want the macro to be run automatically when a specific document is saved? Or when any document is saved?

Only the specific document(s).

[HansV]

Create a new workbook with one worksheet.
Save the workbook as - for example - Wordcount.xlsx.

Open your document.
Press Alt+F11 to activate the Visual Basic Editor.
Double-click ThisDocument under Microsoft Word Objects.
Copy the code listed below into the ThisDocument module.
Change the path (and if necessary, the file name) in the code to that of the workbook that you created.
Switch back to Excel.
If your document is not a macro-enabled document (.docm) yet, save it as a macro-enabled document now.
Each time you close the document, the word count will be updated in the workbook.

Code: Select all

Private Sub Document_Close()
    Dim objXL As Object
    Dim objWB As Object
    Dim objWS As Object
    Dim f As Boolean

    On Error Resume Next
    Set objXL = GetObject(Class:="Excel.Application")
    On Error GoTo ErrHandler
    If objXL Is Nothing Then
        Set objXL = CreateObject(Class:="Excel.Application")
        f = True
    End If
    ' Change the path and filename as needed
    Set objWB = objXL.Workbooks.Open(FileName:="C:\Word\Wordcount.xlsx")
    Set objWS = objWB.Worksheets(1)
    objWS.Range("A1").Value = Me.Range.ComputeStatistics(wdStatisticWords)

ExitHandler:
    On Error Resume Next
    objWB.Close SaveChanges:=True
    If f Then
        objXL.Quit
    End If
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[snb]

I'd use:

Code: Select all

Private Sub Document_Close()
  With GetObject("C:\Word\Wordcount.xlsx")
    .sheets(1).Cells(1) = ThisDocument.ComputeStatistics(0)
'    .sheets(1).cells(1) = ThisDocument.BuiltInDocumentProperties(15)    
    .Close -1
   End With
End Sub

[FrecklePaw]

Would you want the macro to be run automatically when a specific document is saved? Or when any document is saved?

Only the specific document(s).

Apologies Hans, I think I have confused things. I would like to perform this action for when any new document is saved. I have several documents that will be newly created and then I wish to gather the information on word the character count from them in particular as an ongoing thing as each new document is produced. Is this possible?

[HansV]

In the Visual Basic Editor, expand Normal, then Microsoft Word Objects under it (if necessary).
Double-click ThisDocument.
Copy the following code into the ThisDocument module:

Code: Select all

Private WithEvents app As Application

Private Sub app_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
    Dim objXL As Object
    Dim objWB As Object
    Dim objWS As Object
    Dim objCL As Object
    Dim f As Boolean

    If Doc.Name = "Normal.dotm" Then Exit Sub

    On Error Resume Next
    Set objXL = GetObject(Class:="Excel.Application")
    On Error GoTo ErrHandler
    If objXL Is Nothing Then
        Set objXL = CreateObject(Class:="Excel.Application")
        f = True
    End If
    objXL.ScreenUpdating = False
    ' Change the path and filename as needed
    Set objWB = objXL.Workbooks.Open(FileName:="C:\Word\Wordcount.xlsx")
    Set objWS = objWB.Worksheets(1)
    Set objCL = objWS.Range("A:A").Find(What:=Doc.FullName, LookAt:=1, MatchCase:=False)
    If objCL Is Nothing Then
        Set objCL = objWS.Range("A" & objWS.Rows.Count).End(-4162).Offset(1)
        objCL.Value = Doc.FullName
    End If
    objCL.Offset(0, 1).Value = Doc.Range.ComputeStatistics(wdStatisticWords)

ExitHandler:
    On Error Resume Next
    objWB.Close SaveChanges:=True
    If f Then
        objXL.Quit
    Else
        objXL.ScreenUpdating = True
    End If
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

Private Sub Document_Open()
    Set app = Application
End Sub

Quit and restart Word. If it asks you to save the default template Normal.dotm, click Yes.

[FrecklePaw]

Would you want the macro to be run automatically when a specific document is saved? Or when any document is saved?

Only the specific document(s).

Apologies Hans, I think I have confused things. I would like to perform this action for when any new document is saved. I have several documents that will be newly created and then I wish to gather the information on word the character count from them in particular as an ongoing thing as each new document is produced. Is this possible?

Will this then record for all new documents in Word? Is there a way to limit it to documents saved in a particular folder?

[HansV]

Change the line

Code: Select all

    If Doc.Name = "Normal.dotm" Then Exit Sub

to

Code: Select all

    If Doc.Path <> "particular folder path" Then Exit Sub

substituting the actual path.