Reading Excel file with SQL - Code Improvements needed - excel

Question

I have pulled together some code which works, but I must confess to not understanding the nitty gritty of what its doing and I seem to open two lots of connections, which seems slow and messy, one to get the sheetname which I think I need for the SQL call, and the call itself.
I use it as function but have stripped out to a Sub to try and improve it. It gets used a lot pulling in utility data from up to 700 separate files as part of a process, and running across multiple clients. So if it can be streamlined it will cut time down massively.
The file format varies depending on the task:
Alarm Data 51 Columns Wide and either 7 lines or 700 sites *7 lines
Meter Data 50 or 99 Columns Wide with a blank column at 51, 15 lines, or up to 700 * 15 lines
I can't control the file formats/lengths and don't know the sheetname as it can vary by source
Any help tidying it up is massively appreciated.
FootSore
Edit: The files will only ever have one Sheet in them, but name unknown. I only need that sheet.
Function ReadExcelFile(ByRef InputFileArray() As Variant, InputFileName As String, InputFileLocation As String, HeaderYesNo As String)
'Reads Excel File and returns InputFileArray
Dim ReadFileArray() As Variant
Dim connectionString As String
Dim sql As String
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FileExists(InputFileLocation & InputFileName) = True Then
connectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=""" & InputFileLocation & InputFileName & """;" & _
"Extended Properties=""Excel 12.0;HDR=" & HeaderYesNo & ";IMEX=1"""
'This assumes the Excel file contains column headers -- HDR=Yes
'Routine to get unknown sheet name
Set conn = CreateObject("ADODB.Connection")
conn.connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=""" & InputFileLocation & InputFileName & """;" & _
"Extended Properties=""Excel 12.0;HDR=Yes"""
conn.Open
Set bs = conn.OpenSchema(20) ' 20 = adSchemaTables
Do Until bs.EOF = True
'Debug.Print bs.Fields!Table_Name.Value
SheetName = bs.Fields!Table_Name.Value
bs.MoveNext
Loop
bs.Close: conn.Close
Set bs = Nothing
Set conn = Nothing
'Get the contents of the Excel via SQL saves opening file
sql = "SELECT * FROM [" + SheetName + "]" '
'Go to the VBE's Tools, References then locate and put a check beside 'Microsoft ActiveX Data Objects 6.1 Library' to include the library in your project.
Dim rs As New ADODB.Recordset
rs.Open sql, connectionString
ReadFileArray() = rs.GetRows 'Puts the data from the recordset into an array
rs.Close
Set rs = Nothing
'Debugging Tool
'Dim row As Variant, column As Variant
'For row = 0 To UBound(TotalFileArray, 2)
' For column = 0 To UBound(InputFileArray, 1)
' Debug.Print InputFileArray(column, row)
' Next
'Next
'Limitations mean the columns and rows are read in wrong order.
'Public Sub to transpose array
TransposeArray ReadFileArray, InputFileArray
Erase ReadFileArray
Else
End If
End Function

Answer 1

You can re-use the one connection and recordset. Note if your input file has multiple sheets and/or named ranges then this just picks the first one listed.
Also - you're not getting field headers in the returned array.
Sub Tester()
Dim arr
arr = ReadExcelFile("LookupTable.xlsx", "C:\Temp\", True)
If Not IsEmpty(arr) Then 'read any data?
Sheet1.Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End If
End Sub
Function ReadExcelFile(InputFileName As String, InputFileLocation As String, _
HeaderYesNo As String) As Variant
Dim arr As Variant, SheetName As String
Dim sql As String, conn As Object, rs As Object
'ideally you do this check *before* calling the function though...
If Dir(InputFileLocation & InputFileName, vbNormal) = "" Then
MsgBox "File not found!"
Exit Function
End If
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=""" & InputFileLocation & InputFileName & """;" & _
"Extended Properties=""Excel 12.0;HDR=" & HeaderYesNo & ";IMEX=1"""
Set rs = conn.OpenSchema(20) ' 20 = adSchemaTables, NOTE: also reads named ranges...
If Not rs.EOF Then SheetName = rs.Fields("Table_Name").Value 'Always only one sheet?
rs.Close
If Len(SheetName) > 0 Then 'got a sheet?
rs.Open "SELECT * FROM [" + SheetName + "]", conn 're-use connection
If Not rs.EOF Then ReadExcelFile = TransposeArray(rs.GetRows())
End If
End Function
Function TransposeArray(arr)
Dim arrout(), r As Long, c As Long
ReDim arrout(LBound(arr, 2) To UBound(arr, 2), LBound(arr, 1) To UBound(arr, 1))
For r = LBound(arr, 1) To UBound(arr, 1)
For c = LBound(arr, 2) To UBound(arr, 2)
arrout(c, r) = arr(r, c)
Next c
Next r
TransposeArray = arrout
End Function