Чтение файла Excel с помощью SQL

У меня есть код, который работает. Должен признаться, что не понимаю всех тонкостей того, что он делает.

Кажется, я открываю два соединения, что кажется медленным и беспорядочным. Один, чтобы получить имя листа, которое, как мне кажется, мне нужно для вызова 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

Это вообще работает? Вы устанавливаете conn = Nothing перед вызовом rs.Open sql, conn Я думаю, все, что вам нужно сделать, это закрыть bs, и вы можете повторно использовать это для выбранного набора записей. Просто закройте соединение в конце. В VBA нет необходимости устанавливать объектные переменные в Nothing — они выйдут из области видимости, как только ваша подпрограмма выйдет.

Tim Williams 22.11.2022 17:43

О, возможно, нет. Я немного повозился, когда обратился за помощью. В оригинальной версии это была connectionString. И у него был еще один объект Create Object вверху, отражающий первый.

FootSore 22.11.2022 19:09

Если вы ищете "улучшения", то было бы лучше разместить свою рабочую функцию, а не неработающую версию в качестве саба.

Tim Williams 22.11.2022 22:04

Добавил исходный код. Пытался избавиться от одной из строк подключения в моей отредактированной версии.

FootSore 23.11.2022 12:03
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
0
4
73
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Вы можете повторно использовать одно соединение и набор записей. Обратите внимание, что если ваш входной файл имеет несколько листов и/или именованных диапазонов, тогда просто выбирается первый из перечисленных.

Кроме того, вы не получаете заголовки полей в возвращаемом массиве.

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, обрабатывающего все файлы. И обязательно только один лист. Заголовки означают, что даты путаются. Путаница с датами в Великобритании и США. Пропуск заголовков, похоже, гарантирует их правильность.

FootSore 24.11.2022 00:27

В аэропорту был только краткий тест, но точно быстрее. И менее некрасиво. Спасибо за помощь. Вытащил несколько страниц в разделе «Объекты для чтения»!

FootSore 24.11.2022 09:06

Другие вопросы по теме