用SQL阅读Excel文件

jobtbby3 于 2023-03-09 发布在其他

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

我有能用的代码，我必须承认我不明白它在做什么。
我似乎打开了两个连接，这看起来又慢又乱。一个是为了获取我认为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

1条答案

按热度按时间

ee7vknir1#

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

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）举报 2023-03-09

我来回答

用SQL阅读Excel文件

1条答案

相关问题

热门标签

最新问答