Have you ever wanted to quickly list all the Data Connection used by an Excel Workbook, or series of Workbooks? Perhaps to check if a database is being accessed via external sources.
Below is one possible approach in which we simply pass the file path/name to a function which then lists all the connections.
Quick And Dirty Approach
'---------------------------------------------------------------------------------------
' Procedure : Excel_GetConnections
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Extract a list of OleDb Connections from an Excel Workbook
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> none required
' Early Binding -> Microsoft Excel XX.X Object Library
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile : Fully qualified path and filename of the Excel workbook to open
'
' Usage:
' ~~~~~~
' Excel_GetConnections("C:\Users\Dev\Desktop\New Microsoft Excel Worksheet.xlsx")
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2019-01-11
' 2 2021-05-17 Complete rewrite, change header
'---------------------------------------------------------------------------------------
Public Function Excel_GetConnections(sFile As String) As Variant
On Error GoTo Error_Handler
#Const Excel_EarlyBind = False 'True => Early Binding / False => Late Binding
#If Excel_EarlyBind = True Then
Dim oExcel As Excel.Application
Dim oWrkBk As Excel.Workbook
Dim WrkBkConn As Excel.WorkbookConnection
Set oExcel = New Excel.Application
#Else
Dim oExcel As Object
Dim oWrkBk As Object
Dim WrkBkConn As Object
Const xlConnectionTypeOLEDB = 1
Set oExcel = CreateObject("Excel.Application")
#End If
Dim aConnections() As String
Dim lCounter As Long
oExcel.Visible = False 'Show Excel, or not
Set oWrkBk = oExcel.Workbooks.Open(sFile, , True)
If Not oWrkBk Is Nothing Then
For Each WrkBkConn In oWrkBk.Connections
With WrkBkConn
'Debug.Print .Name, .Type;
If .Type = xlConnectionTypeOLEDB Then
' Debug.Print , .OLEDBConnection.CommandText 'Table name
' Debug.Print , .OLEDBConnection.Connection 'Full Connection string
'Debug.Print , .OLEDBConnection.SourceDataFile; 'File path and name
ReDim Preserve aConnections(lCounter)
aConnections(lCounter) = .OLEDBConnection.SourceDataFile & "::" & .OLEDBConnection.CommandText
lCounter = lCounter + 1
End If
'Debug.Print
End With
Next
End If
Excel_GetConnections = aConnections
Error_Handler_Exit:
On Error Resume Next
Set WrkBkConn = Nothing
If Not oWrkBk Is Nothing Then
oWrkBk.Close False
Set oWrkBk = Nothing
End If
oExcel.Quit
Set oExcel = Nothing
Exit Function
Error_Handler:
oExcel.Visible = True 'We have an error be sure to display excel to avoid hidden instances
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: Excel_GetConnections" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Then, we can implement it by doing something like:
Sub Test_Excel_GetConnections()
Dim Conns As Variant
Dim iCounter As Long
Conns = Excel_GetConnections("C:\Users\Dev\Desktop\New Microsoft Excel Worksheet.xlsx")
Debug.Print "File", , , "Table"
Debug.Print String(80, "-")
For iCounter = LBound(Conns) To UBound(Conns)
Debug.Print Split(Conns(iCounter), "::")(0), Split(Conns(iCounter), "::")(1)
Next iCounter
End Sub
which in turn would output something along the lines of:
File Table -------------------------------------------------------------------------------- P:\Databases\Demos\Contacts\Contacts_Demo_V1.01.mdb Contacts C:\Users\Dev\Desktop\Sample33.accdb Table1
In my sample, I’ve concentrated on the connection type 1 => OleDb, but this can be expanded further as your needs dictate to include any of the other data connection types.
Hint: This function would be a great place to use Self-Healing Object Variable if it is to be used to loop through a series of file, and not just a one time usage.
With A Little More Finesse
If you want to take things a little further and make dealing with the information easier, then we can do the following:
Note: the function is not complete, in the sense that not all the properties have been assigned for all the Data Connection Types. I have solely coded the Text, OleDB and ODBC types, the remainder need to be properly tweaked.
Create the following class module:
Option Compare Database
Option Explicit
Private m_ConnFile As String
Private m_ConnName As String
Private m_ConnSrc As String
Private m_ConnType As String
Public Property Get ConnFile() As String
ConnFile = m_ConnFile
End Property
Public Property Let ConnFile(ByVal sConnFile As String)
m_ConnFile = sConnFile
End Property
Public Property Get ConnName() As String
ConnName = m_ConnName
End Property
Public Property Let ConnName(ByVal sConnName As String)
m_ConnName = sConnName
End Property
Public Property Get ConnSrc() As String
ConnSrc = m_ConnSrc
End Property
Public Property Let ConnSrc(ByVal sConnSrc As String)
m_ConnSrc = sConnSrc
End Property
Public Property Get ConnType() As String
ConnType = m_ConnType
End Property
Public Property Let ConnType(ByVal sConnType As String)
m_ConnType = sConnType
End Property
Then Add the following to a standard module
'---------------------------------------------------------------------------------------
' Procedure : Excel_GetConnections
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Extract a list of OleDb Connections from an Excel Workbook
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> none required
' Early Binding -> Microsoft Excel XX.X Object Library
' Dependencies: XLConnections class module
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile : Fully qualified path and filename of the Excel workbook to open
'
' Usage:
' ~~~~~~
' See Test Sub.
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2021-05-17 Initial Release
'---------------------------------------------------------------------------------------
Function Excel_GetConnections_V2(sFile As String) As Collection
On Error GoTo Error_Handler
#Const Excel_EarlyBind = True 'True => Early Binding / False => Late Binding
#If Excel_EarlyBind = True Then
Dim oExcel As Excel.Application
Dim oWrkBk As Excel.Workbook
Dim WrkBkConn As Excel.WorkbookConnection
Set oExcel = New Excel.Application
#Else
Dim oExcel As Object
Dim oWrkBk As Object
Dim WrkBkConn As Object
Const xlConnectionTypeOLEDB = 1
Const xlConnectionTypeODBC = 2
Const xlConnectionTypeXMLMAP = 3
Const xlConnectionTypeTEXT = 4
Const xlConnectionTypeWEB = 5
Const xlConnectionTypeDATAFEED = 6
Const xlConnectionTypeMODEL = 7
Const xlConnectionTypeWORKSHEET = 8
Const xlConnectionTypeNOSOURCE = 9
Set oExcel = CreateObject("Excel.Application")
#End If
Dim XLConnection As XLConnections
Dim XLConnections As New Collection
oExcel.Visible = False 'Show Excel, or not
Set oWrkBk = oExcel.Workbooks.Open(sFile, , True)
If Not oWrkBk Is Nothing Then
Debug.Print oWrkBk.Connections.Count & " connections found."
For Each WrkBkConn In oWrkBk.Connections
With WrkBkConn
Select Case .Type
Case xlConnectionTypeOLEDB
Set XLConnection = New XLConnections
XLConnection.ConnFile = .OLEDBConnection.SourceDataFile
XLConnection.ConnName = .Name
XLConnection.ConnSrc = .OLEDBConnection.CommandText
XLConnection.ConnType = "OLEDB"
XLConnections.Add XLConnection
Case xlConnectionTypeODBC
Set XLConnection = New XLConnections
XLConnection.ConnFile = .ODBCConnection.SourceConnectionFile
XLConnection.ConnName = .Name
XLConnection.ConnSrc = ""
XLConnection.ConnType = "ODBC"
XLConnections.Add XLConnection
Case xlConnectionTypeXMLMAP
Set XLConnection = New XLConnections
XLConnection.ConnFile = ""
XLConnection.ConnName = .Name
XLConnection.ConnSrc = ""
XLConnection.ConnType = "XMLMAP"
XLConnections.Add XLConnection
Case xlConnectionTypeTEXT
Set XLConnection = New XLConnections
XLConnection.ConnFile = Replace(.TextConnection.Connection, "TEXT;", "")
XLConnection.ConnName = .Name
XLConnection.ConnSrc = ""
XLConnection.ConnType = "TEXT"
XLConnections.Add XLConnection
Case xlConnectionTypeWEB
Set XLConnection = New XLConnections
XLConnection.ConnFile = ""
XLConnection.ConnName = .Name
XLConnection.ConnSrc = ""
XLConnection.ConnType = "WEB"
XLConnections.Add XLConnection
Case xlConnectionTypeDATAFEED
Set XLConnection = New XLConnections
XLConnection.ConnFile = ""
XLConnection.ConnName = .Name
XLConnection.ConnSrc = ""
XLConnection.ConnType = "DATAFEED"
XLConnections.Add XLConnection
Case xlConnectionTypeMODEL
Set XLConnection = New XLConnections
XLConnection.ConnFile = ""
XLConnection.ConnName = .Name
XLConnection.ConnSrc = ""
XLConnection.ConnType = "MODEL"
XLConnections.Add XLConnection
Case xlConnectionTypeWORKSHEET
Set XLConnection = New XLConnections
XLConnection.ConnFile = ""
XLConnection.ConnName = .Name
XLConnection.ConnSrc = ""
XLConnection.ConnType = "WORKSHEET"
XLConnections.Add XLConnection
Case xlConnectionTypeNOSOURCE
Set XLConnection = New XLConnections
XLConnection.ConnFile = ""
XLConnection.ConnName = .Name
XLConnection.ConnSrc = ""
XLConnection.ConnType = "NOSOURCE"
XLConnections.Add XLConnection
End Select
End With
Next
End If
Set Excel_GetConnections_V2 = XLConnections
Error_Handler_Exit:
On Error Resume Next
Set WrkBkConn = Nothing
If Not oWrkBk Is Nothing Then
oWrkBk.Close False
Set oWrkBk = Nothing
End If
oExcel.Quit
Set oExcel = Nothing
Exit Function
Error_Handler:
oExcel.Visible = True 'We have an error be sure to display excel to avoid hidden instances
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: Excel_GetConnections_V2" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
and finally, to use it, we simply do:
Sub Test_Excel_GetConnections_V2()
Dim Conns As Collection
Dim Conn As XLConnections
Dim iCounter As Long
Set Conns = Excel_GetConnections_V2("C:\Users\Dev\Desktop\New Microsoft Excel Worksheet.xlsx")
For Each Conn In Conns
With Conn
Debug.Print .ConnName, .ConnType, .ConnFile, .ConnSrc
End With
Next Conn
End Sub
which returns something like:
Connection XMLMAP Contacts_Demo_V1.01 OLEDB P:\Databases\Demos\Contacts\Contacts_Demo_V1.01.mdb Contacts Sample33 OLEDB C:\Users\Dev\Desktop\Sample33.accdb Table1 Text TEXT C:\Users\Dev\Desktop\Text.txt
It is slightly more complex, but is much easier to work with and also add to.
