Import Data from Word into Excel using VBA

[knightofni]

Hello all,

I have a series of word documents (25 in all) which are all completed to the same template.

What I would like to do is transfer the data from Word into Excel for each file.

Is there a way to do this using VBA? I've looked around but have just got stuck!

All suggestions greatly appreicated. Many thanks.

 

[Domenic]

Hopefully, this should get you started. First, place all relevant Word files in a folder. Then specify the path to this folder in the following code, where indicated. Then add the desired code to copy the data from Word and paste it to Excel, where indicated. The following code, as is, creates an instance of Word, loops through each Word file in the specified folder, opens the file, closes the file without saving it, and quits Word.

[FONT=Verdana][COLOR=#000000][FONT=Verdana][COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR][/FONT][/COLOR][/FONT]
 
[FONT=Verdana][FONT=Verdana][COLOR=#000000][COLOR=darkblue]Sub[/COLOR] test()[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=#000000]  [COLOR=darkblue]Dim[/COLOR] WordApp [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR][/COLOR][/FONT]
[COLOR=#000000][FONT=Verdana]  [COLOR=darkblue]Dim[/COLOR] Doc [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR][/FONT]
[FONT=Verdana]  [COLOR=darkblue]Dim[/COLOR] strPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR][/FONT]
[FONT=Verdana]  [COLOR=darkblue]Dim[/COLOR] strFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR][/FONT]
[FONT=Verdana]  [COLOR=darkblue]Dim[/COLOR] Cnt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR][/FONT]
 
[FONT=Verdana]  Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR][/FONT]
 
[FONT=Verdana]  [COLOR=darkblue]Set[/COLOR] WordApp = CreateObject("Word.Application")[/FONT]
 
[FONT=Verdana]  [COLOR=green]'Change the path accordingly[/COLOR][/FONT]
[FONT=Verdana]  strPath = "C:\Users\Domenic\Desktop\"[/FONT]
 
[FONT=Verdana]  [COLOR=darkblue]If[/COLOR] Right(strPath, 1) <> "\" [COLOR=darkblue]Then[/COLOR] strPath = strPath & "\"[/FONT]
 
[FONT=Verdana]  strFile = Dir(strPath & "*.doc")[/FONT]
 
[FONT=Verdana]  [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] Len(strFile) > 0[/FONT]
 
[FONT=Verdana]      Cnt = Cnt + 1[/FONT]
 
[FONT=Verdana]      [COLOR=darkblue]Set[/COLOR] Doc = WordApp.Documents.Open(strPath & strFile)[/FONT]
 
[FONT=Verdana]      [COLOR=green]'Your code to copy data from Word and paste it to Excel[/COLOR][/FONT]
 
[FONT=Verdana]      Doc.Close savechanges:=[COLOR=darkblue]False[/COLOR][/FONT]
 
[FONT=Verdana]      strFile = Dir[/FONT]
 
[FONT=Verdana]  [COLOR=darkblue]Loop[/COLOR][/FONT]
 
[FONT=Verdana]  WordApp.Quit[/FONT]
 
[FONT=Verdana]  [COLOR=darkblue]Set[/COLOR] WordApp = [COLOR=darkblue]Nothing[/COLOR][/FONT]
 
[FONT=Verdana]  Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR][/FONT]
 
[FONT=Verdana]  [COLOR=darkblue]If[/COLOR] Cnt > 0 [COLOR=darkblue]Then[/COLOR][/FONT]
[FONT=Verdana]      MsgBox "Completed...", vbInformation[/FONT]
[FONT=Verdana]  [COLOR=darkblue]Else[/COLOR][/FONT]
[FONT=Verdana]      MsgBox "No '.doc' files were found...", vbExclamation[/FONT]
[FONT=Verdana]  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT]
[/COLOR][/FONT]