Question

我遇到了创建连接字符串（Excel）和查询工作表的问题，我可以获取结果，放入记录集，然后转换为目标工作表。

问题在于，出于某种原因，如果我返回并编辑此工作表（不保存），记录集将缓存OLD结果。例如：我首先查询10行，返回10行，删除7行，再次执行查询但返回原始10，而不是我对其余3的期望。我已彻底使用此方法，并且从未遇到此问题，相信它与记忆有关......

请帮忙......

Public Sub sbTest()

Dim wb As Workbook

Dim wsData As Worksheet, _
wsTmp As Worksheet

Set wb = ThisWorkbook
Set wsData = wb.Sheets("Data"): wsData.Cells.ClearContents
Set wsTmp = wb.Sheets("Temporary")



sSQL = "SELECT * FROM [" & wsTmp.Name & "$]"
Call mUtilities.sbRunSQL(sConnXlsm, wb.FullName, sSQL, wsData.Cells(1, 1))

    'Cleanup
Set wb = Nothing
Set wsData = Nothing
Set wsTmp = Nothing

End Sub


Public Const sConnXlsm As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=zzzzz;Extended Properties=""Excel 12.0 Macro;HDR=YES;IMEX=1"";"

Public Sub sbRunSQL(ByVal sConn As String, ByVal sSource As String, ByVal sSQL As String, ByVal rDest As Range, _
Optional ByVal bHeader As Boolean = True, Optional ByVal bMsg As Boolean = True)


Dim oCn As ADODB.Connection, _
oRs As ADODB.Recordset, _
oFld As ADODB.Field

Dim vArr As Variant

    'Setup
On Error GoTo Cleanup

    'Handle DELETE and INSERT INTO Access queries seperately from other types
If (UCase(Left(sSQL, 6)) = "DELETE" Or UCase(Left(sSQL, 11)) = "INSERT INTO") And sConn = sConnAccess Then

    Set oCn = CreateObject("ADODB.Connection")
    oCn.Open Replace(sConn, "zzzzz", sSource)

    sSQL = Replace(sSQL, "FROM ", "FROM [Excel 8.0;HDR=YES;DATABASE=" & ThisWorkbook.FullName & "].")
    oCn.Execute sSQL

        'Exit if successful
    oCn.Close
    Set oCn = Nothing
    Exit Sub

Else

    Set oRs = Nothing
    Set oRs = New ADODB.Recordset
    oRs.Open sSQL, Replace(sConn, "zzzzz", sSource), adOpenForwardOnly, adLockReadOnly

    If Not (oRs.BOF And oRs.EOF) Then
        vArr = oRs.GetRows
        vArr = fTranspose(vArr)                                 'The .GetRows process tranposes the data so we need to undo this

        If bHeader = True Then
            For i = 0 To oRs.Fields.Count - 1
                rDest.Offset(0, i).Value = oRs.Fields(i).Name
            Next i
            Range(rDest.Offset(1, 0), rDest.Offset(UBound(vArr, 1) + 1, UBound(vArr, 2))) = vArr
        Else
            Range(rDest, rDest.Offset(UBound(vArr, 1), UBound(vArr, 2))) = vArr
        End If

            'Exit if successful
        oRs.Close
        Set oRs = Nothing
        Exit Sub

    End If
End If

    'Cleanup
Cleanup:
If bMsg = True Then
    MsgBox "Critical error!" & vbNewLine & vbNewLine & _
    "Error: " & Err.Description & vbNewLine & vbNewLine & _
    "SQL: " & sSQL, vbCritical + vbOKOnly
End If

Set oCn = Nothing
Set oRs = Nothing

End Sub

Answer 1

对于它的价值，我能够解决这个问题，如果Excel的多个实例打开，问题似乎与某种延迟错误有关。在这种情况下，我只是强迫一本书开放。

Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set oProc = oWMI.ExecQuery("SELECT * FROM Win32_Process WHERE NAME = 'Excel.exe'")

If oProc.Count > 1 Then
    MsgBox "There are " & oProc.Count & " instances of Excel open." & vbNewLine & vbNewLine & _
    "Only 1 instance is allowed open in order to update database.", vbCritical + vbOKOnly
    GoTo Cleanup
End If

ADO记录集似乎缓存旧结果

1 个答案: