我不知道为什么直接在10-11秒内运行的查询会导致Excel停止响应。即使此查询的筛选版本更高，只有193行x 26列，也会导致相同的问题。
按顺序启用参考：
我正在尝试为记录集创建查询表以将数据转储到：
Option Explicit
Sub Import_Data()
On Error GoTo ErrorHandler
Dim BCS As Worksheet
Dim dv As Worksheet
Dim RegAtt As Worksheet
Dim POData As Worksheet
Dim CARData As Worksheet
Dim UserDefinedFilters As String
Dim POFilters As String
Dim Site_List As String
Dim CL As String
Dim FL As String
Dim scenario_year As Integer
Dim Scenario As String
Dim RegSql As String
Dim POSql1 As String
Dim POSql2 As String
Dim POSql3 As String
Dim BCSSql1 As String
Dim BCSSql2 As String
Dim BCSSql3 As String
Dim BCSSql4 As String
Dim CS As String
Dim CS64 As String
Dim CS32 As String
Dim response As String
Dim con As ADODB.Connection
Dim Rs As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim qt As Variant
Dim qt2 As Variant
Dim qt3 As Variant
Dim hdrs As Variant
Dim i As Variant
Set con = New ADODB.Connection
Set rs3 = CreateObject("ADODB.RECORDSET")
Call DeleteConnections
'Test for Mac
#If Mac Then
'if Mac then use this driver
CS = "Driver={Amazon Redshift};SERVER={<rs>};UID=<user>;PASSWORD=<pwd>;DATABASE=<db>;PORT=8192"
#ElseIf Win64 Then
CS64 = "Driver={Amazon Redshift (x64)};SERVER={<rs>};UID=<user>;PASSWORD=<pwd>;DATABASE=<db>;PORT=8192"
con.Open CS64
#Else
CS32 = "Driver={Amazon Redshift (x86)};SERVER={<rs>};UID=<user>;PASSWORD=<pwd>;DATABASE=<db>;PORT=8192"
con.Open CS32
#End If
Application.ScreenUpdating = False
'Filter Fields
Site_List = UCase(ThisWorkbook.Sheets(Sheet1.Name).Range("D1").Value)
CL = UCase(ThisWorkbook.Sheets(Sheet1.Name).Range("D2").Value)
FL = UCase(ThisWorkbook.Sheets(Sheet1.Name).Range("D3").Value)
scenario_year = ThisWorkbook.Sheets(Sheet1.Name).Range("D4").Value
Scenario = "'" & ThisWorkbook.Sheets(Sheet1.Name).Range("D5").Value & "'"
'POData Filters
If CL <> "" And FL <> "" Then
CL = Replace(CL, ", ", ",")
FL = Replace(FL, ", ", ",")
POFilters = POFilters & "UPPER(LEFT(po.po_fbn,3)) in ('" & Replace(CL, ",", "','") & "') " & _
vbNewLine & " AND UPPER(po.po_bn) in ('" & Replace(FL, ",", "','") & "') "
ElseIf CL <> "" And FL = "" Then
CL = Replace(CL, ", ", ",")
POFilters = POFilters & "UPPER(LEFT(po.po_bn,3)) in ('" & Replace(CL, ",", "','") & "') "
ElseIf CL = "" And FL <> "" Then
If InStr(1, FBNList, ",") > 0 Then
FL = Replace(FL, ", ", ",")
POFilters = POFilters & " UPPER(po.po_bn) in ('" & Replace(UCase(FL), ",", "','") & "') "
ElseIf InStr(1, FL, "*") > 0 Then
POFilters = POFilters & " UPPER(po.po_bn) LIKE '%" & Replace(UCase(FL), "*", "") & "%' "
Else
POFilters = POFilters & " UPPER(po.po_bn) in ('" & UCase(FL) & "') "
End If
End If
'This is to refresh PO Data for Look Up
Set POData = ThisWorkbook.Sheets(Sheet5.Name)
POData.Cells.Clear
Sql1 = "WITH build_filter_1 AS ( SELECT build_id FROM dcgs.build_schedule WHERE build_id LIKE '%DCA%')," & _
"build_filter_2 AS ( SELECT build_id FROM dcgs.build_schedule WHERE NOT build_id LIKE '%DCA%' AND build_id LIKE '%.001%')," & _
"build_data AS ( SELECT fbn, CASE WHEN cluster ILIKE'%UNK%' THEN LEFT ( fbn, 3 ) ELSE cluster END AS region, site " & _
"FROM dcgs.build_schedule " & _
"WHERE ( fbn LIKE'%ROM%' OR fbn LIKE'%PRX%' OR fbn LIKE'%IGL%' ) " & _
"AND build_id IN ( SELECT * FROM build_filter_1 UNION ALL SELECT * FROM build_filter_2) " & _
"AND NOT build_status = 'CANCELED'), "
Sql2 = Sql1 & vbNewLine & _
"po AS ( SELECT aa.organization, aa.po_number, aa.po_line_number, aa.buyer, aa.requester, " & _
"aa.po_creation_date, aa.po_close_status, TRIM ( aa.fbn ) AS po_fbn, aa.project, aa.currency, " & _
"aa.unit_price, ROUND(aa.quantity,2) AS quantity, ROUND(aa.quantity_received,2) AS quantity_received, " & _
"ROUND(aa.adjamtord,2) AS amount_ordered, ROUND(aa.adjamtbil,2) AS amount_billed, " & _
"aa.vendor, REGEXP_REPLACE( aa.item_description, '[^[:alnum:]]', ' ' ) AS item_description, " & _
"aa.car_lines, aa.category AS po_category, aa.sub_category, aa.exchange_rate, " & _
"CASE WHEN aa.car_Lines = 'Design_and_Engineering' THEN 'Design' " & _
"WHEN aa.car_Lines = 'Electrical' THEN 'Electrical_Equipment' " & _
"WHEN aa.car_Lines = 'Mechanical' THEN 'Mechanical_Equipment' ELSE aa.car_Lines END category1, " & _
"b.qty_subcategory, b.value_subcategory, cr.line_category_renamed, " & _
"CASE WHEN ca.car_classification = 'Boomerang' THEN 'Yes' ELSE 'No' END AS car_exceptions, " & _
"ROW_NUMBER() OVER ( PARTITION BY aa.project, aa.po_number, aa.item_description ) AS dedupe " & _
"FROM awscfpa.dcgs.po_new aa " & _
"LEFT JOIN dcgs.invoice_att b ON b.item_desc = aa.item_description " & _
"LEFT JOIN dcgs.cat_rename cr ON cr.line_category = aa.category " & _
"LEFT JOIN dcgs.car_att ca ON ca.car_num = aa.project " & _
"WHERE aa.car_lines <> 'Network' AND aa.acct_type = 'CapEx' " & _
"AND ( aa.Quantity <> 0 OR aa.Quantity_Received <> 0 OR aa.Amount_Billed <> 0 OR aa.Amount_Ordered <> 0 OR aa.AdjAmtBil <> 0 OR aa.AdjAmtOrd <> 0 ) " & _
"AND TRIM ( aa.fbn ) IN ( SELECT TRIM ( fbn ) FROM build_data ))"
If POFilters = "" Then
Sql3 = Sql2 & vbNewLine & _
"SELECT po.organization, po.po_number, po.po_line_number, po.buyer, po.requester, po.po_creation_date," & _
"po.po_close_status, po.po_fbn, po.project, po.currency, po.unit_price, po.quantity, po.quantity_received," & _
"po.amount_ordered, po.amount_billed, po.vendor, po.item_description, po.car_lines, po.po_category," & _
"po.sub_category, po.exchange_rate, po.category1, po.qty_subcategory, po.value_subcategory, po.line_category_renamed, po.car_exceptions " & _
"FROM po WHERE dedupe = 1"
Else
Sql3 = Sql2 & vbNewLine & _
"SELECT po.organization, po.po_number, po.po_line_number, po.buyer, po.requester, po.po_creation_date," & _
"po.po_close_status, po.po_fbn, po.project, po.currency, po.unit_price, po.quantity, po.quantity_received," & _
"po.amount_ordered, po.amount_billed, po.vendor, po.item_description, po.car_lines, po.po_category," & _
"po.sub_category, po.exchange_rate, po.category1, po.qty_subcategory, po.value_subcategory, po.line_category_renamed, po.car_exceptions " & _
"FROM po WHERE " & POFilters & " AND dedupe = 1"
End If
rs3.ActiveConnection = con
rs3.Open Sql3
Set qt3 = POData.ListObjects.Add(SourceType:=XlListObjectSourceType.xlSrcQuery, _
Source:=rs3, Destination:=POData.Range("A1")).QueryTable
qt3.Refresh
rs3.Close
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Call DeleteConnections
MsgBox ("Report has encountered an error:" & vbNewLine & Err.Number & " - " & Err.Description & vbNewLine & "Please reach out to <email> for a solution.")
Application.ScreenUpdating = True
End Sub
我还有两个其他记录集，它们是相同的代码，带有不同的查询，可以正常工作。不同的查询之一是64行x 18列，但它具有交叉联接，并且大约需要10秒钟才能运行。
我还试图更改使用CopyFromRecordset输入记录集的方式，并且它执行相同的操作。当我Debug.Print rs3.RecordCount时得到-1，我怀疑这不是意外，因为这是Redshift，并且可能无法分辨出有多少。
此原因导致excel无法响应，我不知道为什么或如何解决它。
编辑：
我尝试执行以下操作：
con.CommandTimeout = 60
Set rs3 = con.Execute(POSql3)
If Not rs3.EOF Then
With POData
.Activate
.Range("A1").CopyFromRecordset rs3
End With
End If
我收到以下错误：
-2147217887 - Multiple-step OLE DB operation generated errors. Check each OLE DB status value, if available. No work was done.
不确定如何处理。
评论时间太长，但请尝试添加一些时间...
Dim t, n As Long
t = Timer
rs3.ActiveConnection = con
Debug.Print "Connected", Timer-t
rs3.Open Sql3
Debug.Print "Opened recordset", Timer-t
Do While Not rs3.EOF
n = n + 1
If n Mod 20 = 0 Then Debug.Print "Fetched " & n, Timer - t
rs3.MoveNext
Loop
Debug.Print "Completed (" & n & " records )", Timer - t
您看到什么输出？