Importing data from multiple XLSX files to a single DOCX file.

[swampmatt]

I've been racking my brain over this for hours...
I have a folder full of hundreds of Excel spreadsheets (2010), all using the exact same template.
I want to import the data from each Excel spreadsheet, into a single running word document.

For example...

Begin with a blank Word document
Open a dialog to select a folder of XLSX documents, all of the exact same template and format (data located in the same cells)
For each XLSX document in that folder....

I want to open the first XLSX document in a specific folder

Copy certain fields to the word document
Close the XLSX document


Open the second XLSX document in a specific folder

Copy the same fields to the word document
Close the XLSX document


repeat until reaching the last XLSX file in the directory.


Save the Word document and close.


I've been racking my brain all night on this one, any help would be appreciated.

[macropod]

Here's some code to get you started. It's a word macro and assumes you want the output to go into that Word document. Your post, however, doesn't indicated where in the Excel workbooks the data come from or where in the Word document they go, so I haven't developed that part.

Sub Demo()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, wdDoc As Document
Dim strFolder As String, strFile As String, bStrt As Boolean
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set wdDoc = ActiveDocument
' Test whether Excel is already running.
bStrt = False ' Flag to record if we start Excel, so we can close it later.
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
With xlApp
'Hide our Excel session
If bStrt = True Then .Visible = False
strFile = Dir(strFolder & "\*.xlsx", vbNormal)
While strFile <> ""
Set xlWkBk = .Workbooks.Open(FileName:=strFile)
'Do whatever data extraction you want here
With wdDoc
End With
xlWkBk.Close False
strFile = Dir()
Wend
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing: Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
'
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

[gmayor]

While Paul's method will work, it is slow to open all those sheets, process them and close them. You could use instead an ADODB connection to read the worksheets into an array and process the array for the indformation, which is dramatically quicker.

You can use a named range instead of the worksheet name if you remove the line
strWorksheetName = strWorksheetName & "$]


Option Explicit
Private RS As Object
Private CN As Object
Private iRows As Long
Private iCols As Long
Const strSheet As String = "Sheet1" 'The name of the common worksheet/range


Private Function xlFillArray(strWorkbook As String, _
strWorksheetName As String) As Variant
strWorksheetName = strWorksheetName & "$]"
Set CN = CreateObject("ADODB.Connection")
CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

Set RS = CreateObject("ADODB.Recordset")
RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1

With RS
.MoveLast
iRows = .RecordCount
.MoveFirst
End With
xlFillArray = RS.GetRows(iRows)
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function

Sub BatchGetData()
Dim arr() As Variant
Dim fDialog As FileDialog
Dim strFilename As String
Dim strPath As String
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
End With
strFilename = Dir$(strPath & "*.xlsx")
While Len(strFilename) <> 0
arr = xlFillArray(strPath & strFilename, strSheet)
ActiveDocument.Range.InsertAfter arr(0, 0) 'column, row - repeat line for each required cell
ActiveDocument.Range.InsertParagraphAfter
strFilename = Dir$()
Wend
End Sub

[swampmatt]

macropod, thanks so much for the code, this is extremely helpful. I'm able to pull data from specific cells within the excel document. How do I then place those values in specific locations in my word document? Below is my current code. You can see where I extract 6 values from specific cells. How do I place those values in specific locations in my word document? Do I use bookmarks? Again, many many thanks!


Sub Demo()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, wdDoc As Document
Dim strFolder As String, strFile As String, bStrt As Boolean
Dim Form1 As Excel.Range
Dim CLIN As Excel.Range
Dim WBSTITLE As Excel.Range
Dim POP As Excel.Range
Dim SOWREF As Excel.Range
Dim CDRLLIST As Excel.Range
Dim SOW As Excel.Range

strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set wdDoc = ActiveDocument
' Test whether Excel is already running.
bStrt = False ' Flag to record if we start Excel, so we can close it later.
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
With xlApp
'Hide our Excel session
If bStrt = True Then .Visible = False
strFile = Dir(strFolder & "\*.xlsx", vbNormal)
While strFile <> ""
Set xlWkBk = .Workbooks.Open(FileName:=strFolder & strFile)
'Do whatever data extraction you want here
Set CLIN = Sheets("BOE Header").Range("B3")
Set WBSTITLE = Sheets("BOE Header").Range("B4")
Set POP = Sheets("BOE Header").Range("B5")
Set SOWREF = Sheets("BOE Header").Range("B8")
Set CDRLLIST = Sheets("BOE Header").Range("B11")
Set SOW = Sheets("BOE Header").Range("B14")


With wdDoc
'Do Word document processing here

End With
xlWkBk.Close False
strFile = Dir()
Wend
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing: Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
'
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function









Here's some code to get you started. It's a word macro and assumes you want the output to go into that Word document. Your post, however, doesn't indicated where in the Excel workbooks the data come from or where in the Word document they go, so I haven't developed that part.

Sub Demo()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, wdDoc As Document
Dim strFolder As String, strFile As String, bStrt As Boolean
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set wdDoc = ActiveDocument
' Test whether Excel is already running.
bStrt = False ' Flag to record if we start Excel, so we can close it later.
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
Set xlApp = CreateObject("Excel.Application")
If xlApp Is Nothing Then
MsgBox "Can't start Excel.", vbExclamation
Exit Sub
End If
' Record that we've started Excel.
bStrt = True
End If
On Error GoTo 0
With xlApp
'Hide our Excel session
If bStrt = True Then .Visible = False
strFile = Dir(strFolder & "\*.xlsx", vbNormal)
While strFile <> ""
Set xlWkBk = .Workbooks.Open(FileName:=strFile)
'Do whatever data extraction you want here
With wdDoc
End With
xlWkBk.Close False
strFile = Dir()
Wend
If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing: Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
'
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

[macropod]

I'm able to pull data from specific cells within the excel document. How do I then place those values in specific locations in my word document? Below is my current code. You can see where I extract 6 values from specific cells. How do I place those values in specific locations in my word document? Do I use bookmarks?
What you use depends on what you want to achieve. Bookmarks won't be much good unless you want to group the data by source cell (e.g. all B4 records go to one bookmark and all B5 records go to another. You probably also don't need all those extra variables you've declared, as you could use code like:

With Sheets("BOE Header")
WdDoc.Bookmarks("CLIN").Range.InsertBefore .Range("B3").Text & vbTab
WdDoc.Bookmarks("WBSTITLE").Range.InsertBefore .Range("B4").Text & vbTab
WdDoc.Bookmarks("POP").Range.InsertBefore .Range("B5").Text & vbTab
'etc.
End with
or:

With Sheets("BOE Header")
WdDoc.Range.InsertAfter vbCr & .Range("B3").Text & vbTab & .Range("B4").Text & vbTab & .Range("B5").Text & vbTab 'etc.
End with

[snb]

If you put 6 docvariable fields in your document; referring to the variables 'it_1', 'it_2' .... 'it_6" respectively.
You can import the values B3, B4 , B5, etc. in sheet "BOE Header" in workbook "G:\OF\example.xlsx" (adapt the filename)


Sub M_snb()
With GetObject("G:\OF\example.xslx")
sn = .Sheets("BOE Header").Range("B3:B14")
.Close 0
End With

For j = 1 To 6
ActiveDocument.Variables("it_" & j) = sn(1, Choose(j, 3, 4, 5, 8, 11, 14))
Next
ActiveDocument.Fields.Update
End Sub

[swampmatt]

Success, many thanks!


What you use depends on what you want to achieve. Bookmarks won't be much good unless you want to group the data by source cell (e.g. all B4 records go to one bookmark and all B5 records go to another. You probably also don't need all those extra variables you've declared, as you could use code like:

With Sheets("BOE Header")
WdDoc.Bookmarks("CLIN").Range.InsertBefore .Range("B3").Text & vbTab
WdDoc.Bookmarks("WBSTITLE").Range.InsertBefore .Range("B4").Text & vbTab
WdDoc.Bookmarks("POP").Range.InsertBefore .Range("B5").Text & vbTab
'etc.
End with
or:

With Sheets("BOE Header")
WdDoc.Range.InsertAfter vbCr & .Range("B3").Text & vbTab & .Range("B4").Text & vbTab & .Range("B5").Text & vbTab 'etc.
End with