3 Word templates need to Export data to 3 Tabs in Excel

I have 3 word template forms that users send in to make requests (I receive multiples requests of each type daily). Everyday I must open each request and just copy/paste all of the responses into the excel sheet on the corresponding tab (3 tabs in the excel file one for each type of request). I add the date at the end of the row in excel so we know when the request came in.

Is there a easy way to create an excel macro to

open each word file found in the directory
The type of request is in the upper left of each request form
go to that tab in my excel template file and copy in each of the answers from the form into the excel line and add the date in the last field?
Move the word files as they are processed to folder called "processed-already"

I need to run this everyday sometimes multiple times and append each new line of data starting at the last row in the existing tab.

Any help you guys can give on this one is greatly appreciated. I have done some minor macros but never to this level of taking data out of word and copying it into an excel file.

Samples of the 3 different request forms and the single excel file that I copy the data into everyday is attached for your reference.
My----Asset-Request-Form.docx
MY---Script---Synopsis-Request-Form.docx
My--Studios-Content-Request-Form.docx
RequestTracker.xlsx
sierra810Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Helen FeddemaCommented:
Since the documents in question are Form Field docs (they are not templates -- those have the extension .dotx or .dotm), you may be able to modify the following code for your use (it is Access VBA that imports values from form field docs).

Private Sub cmdImportFromWord_Click()
'Created by Helen Feddema 25-Sep-2014
'Last modified by Helen Feddema 25-Sep-2014

On Error GoTo ErrorHandler

   Dim fd As Office.FileDialog
   Dim varSelectedItem As Variant
   Dim strFileNameAndPath As String
   Dim cctl As Word.ContentControl
   Dim strControlName As String
   Dim varControlValue As Variant
   
   'Select a filled-in Contact Response letter to process
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
   With fd
      .AllowMultiSelect = False
      .Title = "Browse for Contact Response Letter"
      .ButtonName = "Select"
      .Filters.Clear
      .Filters.Add "Documents", "*.docx", 1
      .InitialView = msoFileDialogViewDetails
      If .Show = -1 Then
         For Each varSelectedItem In .SelectedItems
            strFileNameAndPath = CStr(varSelectedItem)
         Next varSelectedItem
      Else
         Debug.Print "User pressed Cancel"
         strFileNameAndPath = ""
      End If
   End With
   
   If InStr(strFileNameAndPath, "Contact Response Letter") = 0 Then
      strTitle = "Wrong letter"
      strPrompt = "Please select a Contact Response letter to process"
      MsgBox prompt:=strPrompt, _
         buttons:=vbExclamation + vbOKOnly, _
         Title:=strTitle
      GoTo ErrorHandlerExit
   End If
   
   Set appWord = GetObject(, "Word.Application")
   Set doc = appWord.Documents.Open(strFileNameAndPath)
   Set rst = CurrentDb.OpenRecordset("tblContactResponses")
   rst.AddNew
   rst![DocumentName] = strFileNameAndPath
   
   For Each cctl In doc.ContentControls
      Debug.Print "Control name: " & cctl.Tag _
         & "; value: " & cctl.Range
      strControlName = cctl.Tag
      varControlValue = cctl.Range
      rst.Fields(strControlName) = varControlValue
   Next cctl
   
   rst.Update
   rst.Close
   doc.Close savechanges:=wdDoNotSaveChanges
   
   DoCmd.OpenTable "tblContactResponses"
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   If Err = 429 Then
      'Word is not running; open Word with CreateObject
      Set appWord = CreateObject("Word.Application")
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number _
         & " in " & Me.ActiveControl.Name & " procedure; " _
         & "Description: " & Err.Description
      Resume ErrorHandlerExit
   End If
   
End Sub

Open in new window


(the code is from the sample database from my Working with Word ebook.)

Then, in order to get the data into Excel, you would need some code to match up the tabs with document names, and put the values into the appropriate cells in each sheet.  If I have time, I will see if I can work up something, but unfortunately your workbook wouldn't download.
sierra810Author Commented:
sorry, I tried and cannot get it to work. giving errors about the Me.ActiveControl.Name and I took that part out and it then runs but give me other errors like Error 424  :(

Attaching my tracker file again, perhaps if you have time you can take another peak at it.
thank you!
RequestTracker.xls
Helen FeddemaCommented:
I got the workbook this time, and I am working on a procedure.  Some things to note:

The document names should match the sheet names exactly (except for the extension); I have modified them as needed.  You could modify either the doc names or the sheet names, just so they match.

In the documents, most of the data is not in form fields, but is just text in cells of a table.  It would be a lot easier if all data to export is in form fields (or content controls).  Is that possible?  Another possibility is to have all data in table cells, but in that case the tables should be strictly formatted so as to ensure that the right data is picked up (no split cells, for example).  Or thirdly, the data to export could be bookmarked.  Which of these alternatives would work best for your needs?
Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Learn More!
sierra810Author Commented:
Hi Helen, unfortunately the 3 forms predate my working on them and have been in use so long that they cannot be altered at this time. They are to be in the format they are currently in :(  so everyday I copy/paste from them into the excel tabs of the workbook.
Helen FeddemaCommented:
That could be a real problem.  I will do something that will give you a start, and you can do the fine-tuning.  FYI, I think the best method would be to go with all form fields (or all content controls).
Helen FeddemaCommented:
Here is a database that processes one of the docs (Asset-Request -- you can do the rest of the code for the others).  Unfortunately, since they don't have identical formats, each one needs its own specific code.  I use FilePicker and FolderPicker objects to select the workbook and the folder with the Word docs, and some MSForms code to get data from the clipboard.  Check the references In the sample database; you will have to set them if you put the code into another database.  Here is the main procedure:

Public Sub ProcessRequests()
'Created by Helen Feddema 17-Mar-2016
'Last modified by Helen Feddema 17-Mar-2016

On Error GoTo ErrorHandler

   Dim appExcel As Excel.Application
   Dim appWord As Word.Application
   Dim cctl As Word.ContentControl
   Dim dat As MSForms.DataObject
   Dim doc As Word.Document
   Dim intResult As Integer
   Dim rng As Excel.Range
   Dim sel As Word.Selection
   Dim sht As Excel.Worksheet
   Dim strCode As String
   Dim strFinalData As String
   Dim strControlName As String
   Dim strData As String
   Dim strDoc As String
   Dim strFolder As String
   Dim strMessage As String
   Dim strSheet As String
   Dim strWorkbook As String
   Dim varControlValue As Variant
   Dim wkb As Excel.Workbook
   
   strWorkbook = SelectWorkbook
   Debug.Print strWorkbook
   
   'Open workbook
   Set appExcel = GetObject(, "Excel.Application")
   Set appWord = GetObject(, "Word.Application")
   Set wkb = appExcel.Workbooks.Open(strWorkbook)
   
   'Get folder with files to process
   strFolder = GetFolder & "\"
   
   'Process Word docs in folder
   Set fld = fso.GetFolder(strFolder)
   
   For Each fil In fld.Files
      Debug.Print "File name: " & fil.Name
      
      If Right(fil.Name, 4) = "docx" Then
         strDoc = strFolder & fil.Name
         Set doc = appWord.Documents.Open(strDoc)
         strSheet = Left(fil.Name, Len(fil.Name) - 5)
         Debug.Print "Sheet name: " & strSheet
         Set sel = appWord.Selection
         sel.GoTo What:=wdGoToTable, _
            Which:=wdGoToFirst, _
            Count:=1
         appExcel.Visible = True
         wkb.Activate
         Set sht = wkb.Sheets(strSheet)
         sht.Activate
         
         'Paste requestor's name
         sel.MoveRight Unit:=wdCell
         sel.Copy
         Set dat = New MSForms.DataObject
         dat.GetFromClipboard
         strData = dat.GetText
         Debug.Print "Data: " & strData
         Set rng = sht.Range("A2")
         rng.Value = strData
         dat.Clear
         
         'Paste title
         sel.GoTo What:=wdGoToTable, _
            Which:=wdGoToFirst, _
            Count:=2
         sel.MoveRight Unit:=wdCell
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         Set rng = sht.Range("B2")
         rng.Value = strData
         dat.Clear
         
         'Paste description
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         Set rng = sht.Range("C2")
         rng.Value = strData
         dat.Clear
         
         'Paste content
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         Set rng = sht.Range("D2")
         rng.Value = strData
         dat.Clear
         
         'Paste partner's name
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         Set rng = sht.Range("E2")
         rng.Value = strData
         dat.Clear
        
         'Paste partner contact (special case because of split cells)
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strFinalData = dat.GetText
         Set rng = sht.Range("F2")
                  
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         strFinalData = strFinalData & vbCrLf & strData
         
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         strFinalData = strFinalData & vbCrLf & strData
         
         rng.Value = strFinalData
         dat.Clear
         
         'Paste Contact  (special case because of split cells)
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strFinalData = dat.GetText
         Set rng = sht.Range("G2")
         
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         strFinalData = strFinalData & vbCrLf & strData
         
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         strFinalData = strFinalData & vbCrLf & strData
         
         rng.Value = strFinalData
         dat.Clear
         
         'Paste who is handling assets
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         Set rng = sht.Range("J2")
         rng.Value = strData
         dat.Clear
         
         'Paste Watermarked
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         Set rng = sht.Range("K2")
         rng.Value = strData
         dat.Clear
         
         'Paste Not watermarked
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
          Set rng = sht.Range("L2")
         rng.Value = strData
         dat.Clear
         
         'Paste additional
         sel.MoveRight Unit:=wdCell, Count:=2
         sel.Copy
         dat.GetFromClipboard
         strData = dat.GetText
         Set rng = sht.Range("M2")
         rng.Value = strData
         dat.Clear
         
      End If
      
      doc.Close savechanges:=False
      Stop
      
   Next fil
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   'Excel is not running; open Excel with CreateObject
   If Err.Number = 429 Then
      Set appExcel = CreateObject("Excel.Application")
      Resume Next
   Else
      MsgBox "Error No: " & Err.Number _
         & " in ProcessRequests procedure; " _
         & "Description: " & Err.Description
      Resume ErrorHandlerExit
   End If
   
End Sub

Open in new window

If the documents had identical format, the code could be a lot more elegant (even more so if they used form fields or content controls for the data to be exported).
Requests.accdb

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
sierra810Author Commented:
Thank you Helen, I will take it from here!
sierra810Author Commented:
Thank you for all your help!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word

From novice to tech pro — start learning today.