Chihiro
Excel Ninja
I recently did a project and thought I'd share the concept.
Problem:
Needed to merge Sheet1 of multiple workbooks (number of workbooks can vary). All files shared same data structure. It was requested that source workbooks should not be opened.
Normally, I'd use PowerQuery to merge data. However, in this instance environment had mix of Excel 2010, 2013 and 2016. PowerQuery wasn't available to all users of this workbook.
This left MS Query with parameter passed on using VBA or ADO using ACE.OLEDB . Since I'm not too familiar with manipulating MS Query using VBA I went with ACE.OLEDB
But initial code required connection to be opened for each workbook and was bit messy. This got me thinking on how to use single connection to query all workbooks in a folder.
Solution:
By using "IN" clause you can UNION ALL different workbooks using connection to single workbook. It will work for Excel 2007 and up.
In standard module following codes are used.
Function to return array of full file path for each file in folder.
Main procedure.
It should be pretty self explanatory how to use it (it uses FileDialog to pick a folder). Demo files attached. Modules are in ADODB_Merge_Sample workbook. Rest are test files to merge.
Problem:
Needed to merge Sheet1 of multiple workbooks (number of workbooks can vary). All files shared same data structure. It was requested that source workbooks should not be opened.
Normally, I'd use PowerQuery to merge data. However, in this instance environment had mix of Excel 2010, 2013 and 2016. PowerQuery wasn't available to all users of this workbook.
This left MS Query with parameter passed on using VBA or ADO using ACE.OLEDB . Since I'm not too familiar with manipulating MS Query using VBA I went with ACE.OLEDB
But initial code required connection to be opened for each workbook and was bit messy. This got me thinking on how to use single connection to query all workbooks in a folder.
Solution:
By using "IN" clause you can UNION ALL different workbooks using connection to single workbook. It will work for Excel 2007 and up.
In standard module following codes are used.
Function to return array of full file path for each file in folder.
Code:
Function fileList(strPath As String) As Variant
Dim fd As FileDialog
Dim MyPath As String, MyFile As String, tempArr() As String
Dim fNum As Integer: fNum = 0
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = IIf(Right(strPath, 1) <> "\", strPath & "\", strPath)
If .Show <> -1 Then GoTo NextCode
MyPath = .SelectedItems(1) & "\"
End With
NextCode:
MyPath = MyPath
If Not MyPath = "" Then MyFile = Dir(MyPath & "*.xl*")
If MyFile = "" Then
ReDim tempArr(1 To 1): tempArr(1) = ""
fileList = tempArr
Exit Function
End If
Do While MyFile <> ""
fNum = fNum + 1
ReDim Preserve tempArr(1 To fNum)
tempArr(fNum) = MyPath & MyFile
MyFile = Dir()
Loop
fileList = tempArr
Set fd = Nothing
End Function
Main procedure.
Code:
Sub MergeWorkbooks()
Dim cn As Object, rst As Object
Dim strQuery As String, fisrtFile As String
Dim i As Integer, iCols As Integer
Dim x
'Change initial folder as needed
x = fileList("C:\")
If Len(x(1)) > 0 Then
firstFile = x(1)
Else
MsgBox "No file found or folder not selected!!", vbCritical
Exit Sub
End If
OptimizeVBA True
Sheet1.Cells(1).CurrentRegion.Clear
Set cn = CreateObject("ADODB.Connection")
' Add IMEX=1; at end of connection string, if you know some column is alphanumeric mixed
' Or if you don't know if data type is consistent in a column
' It is safer to use IMEX=1; in general. Just note that imported data will be in text format
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & firstFile & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=Yes;"""
.CursorLocation = 3
.Open
End With
'Construct query string
For i = 1 To UBound(x)
If i = 1 Then
strQuery = "SELECT * FROM [Sheet1$]"
Else
strQuery = strQuery & " UNION ALL SELECT * FROM [Sheet1$] IN '" & x(i) & "' 'Excel 12.0 Xml;'"
End If
Next
strQuery = strQuery & ";"
Set rst = CreateObject("ADODB.Recordset")
rst.Open strQuery, cn, 1, 3
'Read through record set and return headers to row1
For iCols = 0 To rst.Fields.Count - 1
Sheet1.Cells(1, iCols + 1).Value = rst.Fields(iCols).Name
Next
Sheet1.Range("A2").CopyFromRecordset rst
OptimizeVBA False
rst.Close
cn.Close
End Sub
Sub OptimizeVBA(isOn As Boolean)
Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
Application.EnableEvents = Not (isOn)
Application.ScreenUpdating = Not (isOn)
ActiveSheet.DisplayPageBreaks = Not (isOn)
End Sub
It should be pretty self explanatory how to use it (it uses FileDialog to pick a folder). Demo files attached. Modules are in ADODB_Merge_Sample workbook. Rest are test files to merge.