Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
388 views
in Technique[技术] by (71.8m points)

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

I am using the following code to read data from Sheet1 of SAME Excel sheet. I load the data into the return array. The Excel sheet file has "read only" checked and is always opened in "READ ONLY" mode.

The issue is that if I change any of the data on Sheet1, because the file is opened as "read only", it won't be reflected in the ADO query. ADO Continues to output what is in the "saved" file and ignores what has been updated in the temp read only version. For example the below pulls value "Col5:6" from cell "E6". If I replace the value to be "test", ADO still outputs "Col5:6"

How can I make ADO read the current data on Sheet1 without having to "save as"?

Sub sbADO()
    Dim sSQLSting As String
    Dim Conn As New ADODB.Connection
    Dim mrs As New ADODB.Recordset
    Dim DBPath As String, sconnect As String
    Dim returnArray

    DBPath = ThisWorkbook.FullName
    sconnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath _
    & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    Conn.Open sconnect
    sSQLSting = "SELECT * From [Sheet1$] "

    mrs.Open sSQLSting, Conn

    returnArray = mrs.GetRows

    mrs.Close
    Conn.Close

    Debug.Print returnArray(4, 4) '>> "Col5:6"

End Sub
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

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:

src

Then I got the result on Sheet2:

result


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...