使用SQL阅读Excel文件-需要代码改进

vfh0ocws 于 2022-11-26 发布在其他

关注(0)|答案(1)|浏览(122)

我已经整理了一些可以工作的代码，但我必须承认，我不了解它所做的事情的本质，我似乎打开了两个连接，这似乎缓慢而混乱，一个是为了获得我认为我需要的SQL调用的sheetname，另一个是调用本身。
我把它作为函数使用，但是为了改进它，我把它剥离成了一个Sub。它经常被用来从多达700个独立的文件中提取实用程序数据，作为一个进程的一部分，并在多个客户端上运行。所以如果它能被简化，它将大大减少时间。
文件格式因任务而异：报警数据51列宽，7行或700个站点 *7行 Jmeter 数据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

excel

来源：https://stackoverflow.com/questions/74536061/reading-excel-file-with-sql-code-improvements-needed

1条答案

按热度按时间

zfycwa2u1#

您可以重复使用一个连接和记录集。请注意，如果您的输入文件有多个工作表和/或命名区域，那么它只会选择列出的第一个。
此外，您不会在返回的数组中获得字段标题。

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

赞(0）回复(0）举报 2022-11-26

我来回答

使用SQL阅读Excel文件-需要代码改进

1条答案

相关问题

热门标签

最新问答