2017-01-06 2 views
0

Je rencontre un problème lorsque je crée une chaîne de connexion (Excel) et interroge une feuille de calcul, je peux obtenir les résultats, placés dans un jeu d'enregistrements, puis transposés dans une feuille de calcul de destination.Le jeu d'enregistrements ADO semble mettre en cache les anciens résultats

Le problème est que, pour une raison quelconque, si je retourne en arrière et édite cette feuille de calcul (sans enregistrer), le jeu d'enregistrements met en cache les résultats OLD. Par exemple: j'ai d'abord interrogé 10 lignes, renvoyé 10, supprimé 7 d'entre eux, exécuter à nouveau la requête mais il retourne l'original 10 par opposition à mes attentes pour les 3 restants. J'ai utilisé cette méthode à fond et n'ai jamais eu ce problème. croire que ce soit la mémoire liée en quelque sorte ...

S'il vous plaît aider ...

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 
+1

Quelle feuille de travail est modifiée et non enregistrée? Celui que vous interrogez? Si oui, pourquoi * devrait-il refléter vos changements si vous ne les avez pas sauvegardés? – Comintern

Répondre

0

pour ce que ça vaut, j'ai pu résoudre ce problème et semble être lié à une sorte de bug de latence si plusieurs instances d'Excel sont ouvertes J'ai simplement forcé qu'un seul livre soit ouvert dans de tels cas.

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