Anyway for ADO to read updated data from a read-only excel file before save? (VBA)

て烟熏妆下的殇ゞ 提交于 2019-11-28 13:03:09

You can't read unsaved changes from Excel worksheet with ADO since the unsaved data is located in the memory (RAM, and probably swap file), and ADO designed to connect to DB files or server-based DBs.

If you believe that SQL is the only way, and your WHERE clause is quite simple then you can use an ADO Recordset built in functionality for filtering and sorting, without making connection. Do the following:

  1. Get the value of the source range in XML format, fix field names.
  2. Create XML DOM Document and load the XML string.
  3. Create ADO Recordset and convert the document.
  4. Make necessary filtering and sorting. Note, there is some limitations on filter criteria syntax.
  5. Process the resulting recordset further, e. g. output to another worksheet.

There is an example of the code:

Option Explicit

Sub FilterSortRecordset()
    Dim arrHead
    Dim strXML As String
    Dim i As Long
    Dim objXMLDoc As Object
    Dim objRecordSet As Object
    Dim arrRows

    ' get source in XML format
    With Sheets("Sheet1")
        arrHead = Application.Index(.Range("A1:G1").Value, 1, 0)
        strXML = .Range("A2:G92").Value(xlRangeValueMSPersistXML)
    End With

    ' fix field names
    For i = 1 To UBound(arrHead)
        strXML = Replace(strXML, "rs:name=""Field" & i & """", "rs:name=""" & arrHead(i) & """", 1)
    Next

    ' load source XML into XML DOM Document
    Set objXMLDoc = CreateObject("MSXML2.DOMDocument")
    objXMLDoc.LoadXML strXML

    ' convert the document to recordset
    Set objRecordSet = CreateObject("ADODB.Recordset")
    objRecordSet.Open objXMLDoc

    ' filtering and sorting
    objRecordSet.Filter = "City='London' OR City='Paris'"
    objRecordSet.Sort = "ContactName ASC"

    ' populate another sheet with resulting recordset
    arrRows = Application.Transpose(objRecordSet.GetRows)
    With Sheets("Sheet2")
        .Cells.Delete
        .Cells.NumberFormat = "@"
        For i = 1 To objRecordSet.Fields.Count
            .Cells(1, i).Value = objRecordSet.Fields(i - 1).Name
        Next
        .Cells(2, 1).Resize(UBound(arrRows, 1), UBound(arrRows, 2)).Value = arrRows
        .Columns.AutoFit
    End With
End Sub

The sourse data on Sheet1 is as follows:

Then I got the result on Sheet2:

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!