Excel VBA: Create Connection to each excel file in a given folder

nopers

New Member
Joined
Oct 7, 2014
Messages
1
I wanted to make a VBA subroutine that created a connection to each excel file in a given folder, give each connection a specific name, and create a link to a named range in each connected file so that I can refresh all of the data from these files into one worksheet. The imported excel files are all the same template and identical, except for the specific data values in their cells. I wanted to share my findings and offer sample code:

1) I could not find a way to create a connection object and then pass it to a new QueryTable or ListObject. I wanted to use WorkbookConnection objects because you can modify all their paramters directly (including the name). Unfortunately, it seems that Excel only allows creating connection objects, but you cannot create a destination using the object in VBA - you can only use QueryTables.Add or ListObjects.Add and pass it the ConnectionString which does not have all the parameters I'd like to modify. An alternative I found includes using the QueryTables.Add method, which indirectly creates a connection, to paste it to a range, and then figure out what connection was just created by searching through Connections for a name like "connection" and rename it.
2) Excel limits connections to a max of 64!
3) The connection string you actually need to pass when creating a connection is quite simpler than what the connection string will be after any connection is created. Here is a good source for building connection strings: Excel connection strings - ConnectionStrings.com
4) OLE DB is the type of connection you want (specific for connecting to other excel files). There are 2 types: OLEDB and ODBC.
5) Certain parameters or methods of creating connections may cause excel to prompt user to fill out information or select a source table (such as ThisWorkbook.Connections.AddFromFile). I want it fully automated so I avoided these.
6) Refresh all connections using: ThisWorkbook.RefreshAll
7) If MaintainConnection = True (default), the excel files will be locked for editing, even if they are shared workbooks.

Code:
Option Base 1
Option Explicit
Option Compare Text
'Search string for export excel files to import.  Single character wildcard (?) allows searching for xls or xlsm, xlsx, etc
Private Const FilenameSearch As String = "*.xls?"
Private Const FolderName As String = "C:\FolderName\"
'Source addresses for data
Private Const SourceAddress As String = "SourceAddress" 'Named range, workbook scope
'# of rows in source table being imported
Private Const SourceRows As Integer = 3
'Destination address of data
Private Const DestinationAddress As String = "DestinationAddress" 'Named range, workbook scope
'Connection limit
Private Const ConnectionLimit As Integer = 64
'Creates an OLE DB connection for each workbook in given directory (see worksheet's hyperlink)
'   Looks for all .xls? files that are not this workbook nor the template workbook
'If an excel file has not been modified in specified # days it will be deleted.
'Pass full path of the directory to search for files
Public Sub ImportFiles()
    Dim dirPath As String 'Path Dir() returns
    Dim folderPath As String 'path of sheets
    Dim fullFileName As String 'current file being imported
    Dim destRange As Range
    Dim rowIndex As Integer 'destination cell index
    
    'Test if valid directory; returns "" if bad link or no link
    'In Microsoft Windows, Dir supports the use of multiple character (*) and single character (?) wildcards to specify multiple files
    fullFileName = folderPath & FilenameSearch
    dirPath = Dir(fullFileName, vbNormal) 'NOTE: for some reason this doesn't work with relative references: EG folderpath "..\FolderName\"
    
    'Verify valid path and search returns at least one result
    If dirPath = "" Then
        'Let user know bad path
        MsgBox "Invalid Folder!"
    Else
        fullFileName = folderPath & dirPath 'Must use actual filename, not with wildcards (search text)
        'Set import address
        Set destRange = SummaryWksht.Range(DestinationAddress)
        rowIndex = 1 'Set row index to first
    End If
    
    'Loop through each workbook and create connection to summary table
    Do While dirPath <> ""
        'Create connection and increase rowIndex
        'Need to select the first cell only or querytables.add will throw error
        CreateConnection fullFileName, destRange(rowIndex, 1)
        rowIndex = rowIndex + SourceRows
        'Check if out of limits
        If rowIndex > destRange.Rows.count Then
            Exit Do
        ElseIf ThisWorkbook.Connections.count >= ConnectionLimit Then
            Exit Do
        End If
        
        dirPath = Dir 'Call dir after every iteration
        fullFileName = folderPath & dirPath 'Must use actual filename, not with wildcards (search text)
    Loop
End Sub
'Generates OLE DB connection string with a valid excel filename
'Include full path and extension
Private Function GetConnectionString(ByVal fileName As String)
    GetConnectionString = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    fileName & _
    ";Extended Properties=""Excel 12.0 Xml;HDR=NO"""
End Function
'Pass a valid excel filename to create a connection and querytable and insert it into RawData
'Include full path and extension
'Must pass reference to destination range
Private Sub CreateConnection(ByVal fileName As String, ByRef destRange As Range)
    With SummaryWksht.QueryTables.Add(Connection:=GetConnectionString(fileName), destination:=destRange)
        .AdjustColumnWidth = True
        .BackgroundQuery = True 'Allows updating in background while user uses excel
        .CommandText = SourceAddress
        .CommandType = xlCmdTable
        .FieldNames = False
        .Name = GetWorkbookNameFromFileName(fileName) & "_" & SourceAddress & "_" & "QueryTable" 'give QT a unique name
        .FillAdjacentFormulas = False
        .PreserveColumnInfo = True
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshPeriod = 0
        .RefreshStyle = xlOverwriteCells 'overwrite prevents from inserting rows or columns
        .RowNumbers = False
        .SavePassword = True
        .SaveData = True
        .EnableEditing = True 'disable user from being able to edit connection
        .EnableRefresh = True 'Can be refreshed by user.
        .MaintainConnection = False 'Must make false to allow users to access files simultaneously, else connection is kept open and only allows read-only for users
        .Refresh '- REQUIRED to get data to update
    End With
End Sub
'Returns workbook name without extension from filename
'Assumes there is a "\" and a "." in filename
'pass workbook.fullname
Public Function GetWorkbookNameFromFileName(ByVal fileName As String) As String
    Dim startIndex, endIndex As Integer
    startIndex = InStrRev(fileName, "\", -1, vbTextCompare) + 1
    endIndex = InStrRev(fileName, ".", -1, vbTextCompare)
    GetWorkbookNameFromFileName = Mid(fileName, startIndex, endIndex - startIndex)
End Function

Thoughts? Comments?
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Forum statistics

Threads
1,215,465
Messages
6,124,980
Members
449,201
Latest member
Lunzwe73

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top