Prepare for the PMI Agile Certified Practitioner (PMI-ACP)® exam, which formally recognizes your knowledge of agile principles and your skill with agile techniques.
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
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
Do more with
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
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).
(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.
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
(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.
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
Attaching my tracker file again, perhaps if you have time you can take another peak at it.
thank you!
RequestTracker.xls
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?
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?
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.
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).
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:
Requests.accdb
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
Requests.accdb
Premium Content
You need an Expert Office subscription to comment.Start Free Trial