Question

我在excel表上运行SQL查询： Table1 。查询在第一次执行时运行正常。但是后来，在对 Table1 进行一些更改之后，当运行完全相同的SQL查询时，它会一直返回它第一次获取的相同值。

无论我做什么，它都只会重置＆＃39;当我完全关闭excel并再次打开时。我假设连接或记录集正在发生一些事情，但我无法看到问题。有人可以看看它并告诉我出了什么问题吗？

Sub createConsolidatedTable()

Dim conn As Object, rs As Object
Dim tbl As ListObject
Dim icols As Integer

Application.Calculate

ThisWorkbook.Sheets("Temp2").Cells.Clear

With ThisWorkbook.Sheets("Temp1")
    .Calculate
    Set tbl = .ListObjects("Table1")
End With

Set conn = CreateObject("ADODB.Connection")

With conn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
    "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
    .Open
End With

On Error GoTo CloseConnection

Set rs = CreateObject("ADODB.Recordset")

With rs
    .ActiveConnection = conn
    .CursorType = adOpenKeyset
    .Source = getSQL(tbl)
    .Open
End With

With ThisWorkbook.Sheets("Temp2") 'Destination
    For icols = 0 To rs.Fields.Count - 1
        .Cells(1, icols + 1).Value = rs.Fields(icols).Name
    Next
    .Range("A2").CopyFromRecordset rs 'Create table with new data
    .ListObjects.Add(SourceType:=xlSrcRange, _
            Source:=.Range("A1").CurrentRegion, _
            XlListObjectHasHeaders:=xlYes, _
            TableStyleName:=tbl.TableStyle).Name = "Table2"
End With


CloseRecordset:
    rs.Close
    Set rs = Nothing

CloseConnection:
    conn.Close
    Set conn = Nothing

    Debug.Print "Finished table creation"

End Sub

Function getSQL(tbl As ListObject) As String
    ' create sql instruction
    Dim SQL As String, SheetName As String, RangeAddress As String
        SQL = "SELECT [Business Area], [Company Type], [SOURCE], [Customer Country], [Product], [Segment]" & _
            ", [Ship Year], [Ship 6M], [Ship 3M]" & _
            ", Sum([Quantity]) AS [Sum Quantity], Sum([Amount LCY]) AS [Sum Amount LCY]" & _
            ", Sum([Out Amount LCY]) AS [Sum Out Amount LCY], Sum([Profit]) AS [Sum Of Profit]" & _
            ", Sum([Out Profit LCY]) AS [Sum Out Profit LCY], [Finished Product]" & _
        " FROM [SheetName$RangeAddress]" & _
            " GROUP BY [Business Area], [Company Type], [SOURCE], [Customer Country], [Product], [Segment]" & _
            ", [Ship Year], [Ship 6M], [Ship 3M], [Finished Product]" & _
        " Union ALL" & _
        " SELECT [Business Area], [Company Type], [SOURCE], [Customer Country], [Product], [Segment]" & _
            ", NULL, NULL, NULL" & _
            ", Sum([Quantity]) AS [Sum Quantity], Sum([Amount LCY]) AS [Sum Amount LCY]" & _
            ", Sum([Out Amount LCY]) AS [Sum Out Amount LCY]" & _
            ", Sum([Profit]) AS [Sum Of Profit]" & _
            ", Sum([Out Profit LCY]) AS [Sum Out Profit LCY], NULL" & _
        " FROM [SheetName$RangeAddress] WHERE [SOURCE]='BACKLOG'" & _
        " GROUP BY [Business Area], [Company Type], [SOURCE], [Customer Country], [Product], [Segment];"

    SheetName = tbl.Parent.Name
    RangeAddress = tbl.Range.Address(False, False)
    SQL = Replace(SQL, "SheetName", SheetName)
    SQL = Replace(SQL, "RangeAddress", RangeAddress)
    getSQL = SQL

End Function

Answer 1

好的，解决方案就像添加ThisWorkbook.Save一样简单。感谢Vityata，CLR和Harassed Dad，你救了我。

Answer 2

考虑使用QueryTables与ListObjects的接口，并且可以直接在SQL查询上运行，每次刷新。通过这种方式，您可以避免使用ADO连接和记录集对象，甚至构建列标题。

Sub BuildQueryTable()
On Error GoTo ErrHandle
    Dim constr As String
    Dim tbl As ListObject

    Application.Calculate

    With ThisWorkbook.Sheets("Temp1")
        .Calculate
        Set tbl = .ListObjects("Table1")
    End With

    With ThisWorkbook.Sheets("Temp2")
        .Cells.Clear
        .Activate
    End With

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

    With ThisWorkbook.Sheets("Temp2").ListObjects.Add(SourceType:=0, _
                                           Source:=constr, _
                                           Destination:=Range("$A$1")).QueryTable        
         .CommandText = getSQL(tbl) 
         .ListObject.DisplayName = "Table2" 
         .Refresh BackgroundQuery:=False 
    End With

ExitHandle:
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume ExitHandle
End Sub

Function getSQL(tbl As ListObject) As String
   ' same as before ...
End Function

Excel VBA SQL记录集不刷新

2 个答案: