Set FSO = CreateObject("Scripting.FileSystemObject")
totalwordcount = 0
ShowSubfolders FSO.GetFolder("D:\My Documents\Thesis")
msgbox(totalwordcount)

Sub ShowSubFolders(Folder)
 For Each Subfolder in Folder.SubFolders
	Set SubFiles = Subfolder.Files
	For Each objFile in SubFiles
		if FSO.GetExtensionName(objFile) = "docx" then
			GetWordCount FSO.GetAbsolutePathName(objFile)
		end if
	Next

	ShowSubFolders Subfolder
 Next
End Sub

Sub GetWordCount(worddoc)

if InStr(1,worddoc,"~",1) = 0 then

	Set wrd = CreateObject("Word.Application")
	wrd.Visible = True 'False
	Set objDoc = wrd.Documents.Open(worddoc)
	intword = objDoc.ComputeStatistics(wdStatisticPages)
	totalwordcount = totalwordcount + intword
	wrd.Quit(True)

end if

End Sub