У меня есть код, который работает. Должен признаться, что не понимаю всех тонкостей того, что он делает.
Кажется, я открываю два соединения, что кажется медленным и беспорядочным. Один, чтобы получить имя листа, которое, как мне кажется, мне нужно для вызова SQL и самого вызова.
Я использую это как функцию, но разделил его на сабвуфер, чтобы попытаться улучшить его.
Он извлекает служебные данные из 700 отдельных файлов и работает на нескольких клиентах. Если его можно упростить, это значительно сократит время.
Формат файла зависит от задачи:
Данные тревоги 51 столбец шириной и либо 7 строк, либо 700 сайтов * 7 строк
Данные счетчика шириной 50 или 99 столбцов с пустым столбцом на 51, 15 строк или до 700 * 15 строк
Я не могу контролировать форматы/длины файлов, а имя листа зависит от источника.
В файлах только один лист, имя неизвестно.
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
О, возможно, нет. Я немного повозился, когда обратился за помощью. В оригинальной версии это была connectionString. И у него был еще один объект Create Object вверху, отражающий первый.
Если вы ищете "улучшения", то было бы лучше разместить свою рабочую функцию, а не неработающую версию в качестве саба.
Добавил исходный код. Пытался избавиться от одной из строк подключения в моей отредактированной версии.
Вы можете повторно использовать одно соединение и набор записей. Обратите внимание, что если ваш входной файл имеет несколько листов и/или именованных диапазонов, тогда просто выбирается первый из перечисленных.
Кроме того, вы не получаете заголовки полей в возвращаемом массиве.
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
Выглядит хорошо. Думаю, мне нужно лучше понимать объекты и наборы записей. Предыдущие объемы файлов никогда не нуждались в значительной оптимизации. Получите данные, обработайте и создайте отчет. Это выглядит великолепно. Я знаю, что файл существует, потому что он получен из запроса DIR, обрабатывающего все файлы. И обязательно только один лист. Заголовки означают, что даты путаются. Путаница с датами в Великобритании и США. Пропуск заголовков, похоже, гарантирует их правильность.
В аэропорту был только краткий тест, но точно быстрее. И менее некрасиво. Спасибо за помощь. Вытащил несколько страниц в разделе «Объекты для чтения»!
Это вообще работает? Вы устанавливаете
conn = Nothing
перед вызовомrs.Open sql, conn
Я думаю, все, что вам нужно сделать, это закрытьbs
, и вы можете повторно использовать это для выбранного набора записей. Просто закройте соединение в конце. В VBA нет необходимости устанавливать объектные переменные вNothing
— они выйдут из области видимости, как только ваша подпрограмма выйдет.