Ошибка автоматизации с SQL-запросом с помощью SUM и GROUP BY для таблицы Excel - PullRequest
Новая
       45

Ошибка автоматизации с SQL-запросом с помощью SUM и GROUP BY для таблицы Excel

0 голосов
/ 06 июля 2018

Я пытаюсь группировать и суммировать определенные столбцы с помощью запросов SQL и копировать результат в другой рабочий лист, но он выдает

Ошибка времени выполнения -2147217887 (80040e21): ошибка автоматизации

Я не могу понять почему по какой-то причине и выбрасываю ошибку на .Open.

пожалуйста, найдите фото таблицы Excel

enter image description here

Код: 

Sub CreateConsolidatedTable()
    Const adOpenKeyset = 1
    Const adLockOptimistic = 3
    Const WORKSHEETNAME As String = "Sheet1"
    Const TABLENAME As String = "Table1"

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

    Dim Destination As Range
    Set Destination = ThisWorkbook.Worksheets("Sheet2").Range("C1")
Set rg = ThisWorkbook.Worksheets("Sheet1").UsedRange
Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects.Add(xlSrcRange, rg, , xlYes)

    'Set tbl = Worksheets(WORKSHEETNAME).ListObjects(TABLENAME)

    Set conn = CreateObject("ADODB.Connection")
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    conn.Open
    '  On Error GoTo CloseConnection
    Set rs = CreateObject("ADODB.Recordset")
    With rs
        .ActiveConnection = conn
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = getSQL(tbl)
        .Open

        With Destination
            tbl.HeaderRowRange.Copy .Range("c1")
            .Range("c2").CopyFromRecordset rs
            .Parent.ListObjects.Add SourceType:=xlSrcRange, Source:=.Range("c1").CurrentRegion, XlListObjectHasHeaders:=xlYes, TableStyleName:=tbl.TableStyle

        End With
    End With
CloseRecordset:
    rs.Close
    Set rs = Nothing
CloseConnection:
    conn.Close
    Set conn = Nothing
End Sub

Function getSQL(tbl As ListObject) As String
    Dim SQL As String, SheetName As String, RangeAddress As String
    SQL = "SELECT DISTINCTROW [DATE_], [ACCOUNT_CODE], Sum([PRINCIPAL_DUE]) AS [Sum Of PRINCIPAL_DUE],[GL_HEAD_CODE_PRINCIPAL], Sum([INTEREST_DUE]) AS [INTEREST_DUE],[INTEREST_RATE]" & _
          " FROM [SheetName$RangeAddress]" & _
          " GROUP BY [ACCOUNT_CODE], [GL_HEAD_CODE_PRINCIPAL], [DATE_];"

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

    getSQL = SQL
End Function

1 Ответ

0 голосов
/ 06 июля 2018

Следующая строка SQL работает нормально, она группирует и суммирует соответственно. 

SQL = "SELECT [DATE_], [ACCOUNT_CODE], Sum([PRINCIPAL_DUE]) AS [Sum Of PRINCIPAL_DUE],[GL_HEAD_CODE_PRINCIPAL], Sum([INTEREST_DUE]) AS [INTEREST_DUE] " & _
      " FROM [SheetName$RangeAddress]" & _
      " GROUP BY [ACCOUNT_CODE], [GL_HEAD_CODE_PRINCIPAL], [DATE_];"

Это основано на моих данных макета. Если в качестве входных данных выдается такое же количество строк, то убедитесь, что поля, по которым вы группируете, не скрывают никаких дополнительных данных (например, отметку времени в столбце даты), которые могут фрагментировать группировку.

...