VBA bulk extracts self-scoring in Word tables

There are a wide range of inefficient office practices, such as a yearly self-rating. A breakdown of the scores for the Word document, one item per line, each item to fill in the score items and scores, the team leader after the audit into Excel submitted. The main concern is that a list of scores in a Word document is going to be translated into an Excel line, and if a person copies it, pastes it into Excel, copies it, and then transpose it. A lot of people, looks very troublesome. Then wrote a piece of VBA to handle, here to keep the backup.

　　

Sub Rollup Personal Ratings () Dim folderpath$, filename$, filepath$ Dim Wdapp As Object Dim Doc As Object Dim Tbl As Object    Dim Index&, Irow&, icol& cells.clearcontents Set wdapp = CreateObject ("Word.Application") FolderPath = Thisworkbook.path & "\" FileName = Dir (FolderPath & "*.doc*") IRow = 0 Do While Filenam E <> "" IRow = iRow + 1 FilePath = folderpath & FileName Set Doc = WdApp.documents.Open (Fil Epath) Set TBL = doc.tables (1) Cells (IRow, 1). Value = Withnosymbol (TB. Cell (1, 2). Range.Text) Icol = 1 for index = 3 to icol = icol + 1 Cells (IRow, Icol). Value = Withnosymbol (TB. Cell (Index, 5). Range.Text) Next Index icol = icol + 1 ' Cells (IRow, Icol). Value = Withnosymbol (TB. Cell (27, 9). Range.Text) Doc.close FileName = Dir Loop wdapp.quit Set wdapp = Nothing End subfunction Withnos Ymbol (ByVal OrGstr As String) As String Withnosymbol = Left (Orgstr, Len (ORGSTR)-2) ' Remove Word document cell after adding two symbols end Function 

　　

VBA bulk extracts self-scoring in Word tables