Sub WordCount()

Dim n As Long
n = 0
For Each w In ActiveDocument.Words
    w.Select
    If UCase$(Left$(w, 1)) Like "[A-Z]" Then
    n = n + 1
    Debug.Print n
    End If
Next

End Sub