如何解决在 VBA 中运行时，SQL 查询未显示所有结果
我在 SSMS 中运行以下代码并获得 1,481 个结果。
DECLARE @sql NVARCHAR(MAX);
SET @sql =
STUFF(
(SELECT
NCHAR (10) + N'UNION ALL' + NCHAR(10) +
N'SELECT
LEFT('+ QUOTENAME(d.name,'''') + N',LEN('+ QUOTENAME(d.name,'''') + N') - 12) AS Office,pt_copysupp COLLATE latin1_General_CI_AS as supplier_Code,suname COLLATE latin1_General_CI_AS as supplier_Name,pt_date as Tran_Date,pt_trantype COLLATE latin1_General_CI_AS as Tran_Type,pt_header_ref COLLATE latin1_General_CI_AS as Tran_Ref,pt_gross as Local_Gross,pt_currencycode COLLATE latin1_General_CI_AS as Foreign_Currency_Code,pt_curr_valu As Foreign_Currency_Gross
FROM ' + QUOTENAME(d.name) + '.dbo.pl_transactions
inner Join ' + QUOTENAME(d.name) + '.dbo.pl_accounts on ' + QUOTENAME(d.name) + '.dbo.pl_transactions.pt_copysupp = ' + QUOTENAME(d.name) + '.dbo.pl_accounts.sucode
where pt_trantype in (''INV'',''CRN'',''PAY'')
and pt_date between ''1/1/2020'' and ''12/31/2020''
and su_country like ''%China%'''
FROM sys.databases d
WHERE NAME like '%AccountsLive'
FOR XML PATH(''),TYPE)
.value('text()[1]','nvarchar(max)'),1,11,'');
exec(@sql);
但是，当将此代码放入 VBA 以构建更广泛使用的电子表格（见下文）时，仅显示 145 个结果？
Sub supplier_country()
'run sql based on supplier country
Dim Conn As Object
Dim recset As Object
Dim sqlQry As String
Dim sConnect As String
Dim i As Integer
Dim c As Range
Dim DataBaseSource As String
Dim ServerSource As String
Dim SCountry As String
Dim lrow As Long
Application.displayAlerts = False
Application.ScreenUpdating = False
Set Conn = CreateObject("ADODB.Connection")
Set recset = CreateObject("ADODB.Recordset")
'if supplier name is empty go to next macro
If IsEmpty(Range("C11")) Then
'go to next macro
analysis_code
Else
'clear sheet contents
ActiveSheet.Rows("17:1000000").Clear
'set parameters
ServerSource = Sheets("Servers + Databases").Range("G27").Value 'choose the server the database is located
Invoiceto = Format$(Sheets("Search").Range("C5").Value,"m/d/yyyy") 'choose the date the search starts from
InvoiceFrom = Format$(Sheets("Search").Range("C6").Value,"m/d/yyyy") 'choose the date the search ends from
SCountry = Range("C11").Value 'choose supplier country to search by
'insert server name and database name
sConnect = "Provider=sqlOLEDB.1;" & _
"Password=ExcelRep0rt;" & _
"User ID=ExcelReport;" & _
"Data Source=" & ServerSource & ";" & _
"Use Encryption for Data=False"
Conn.Open sConnect
'sql query
sqlQry = " SET NOCOUNT ON DECLARE @sql NVARCHAR(MAX);" & _
" SET @sql =" & _
" STUFF(" & _
" (SELECT" & _
" NCHAR (10) + N'UNION ALL' + NCHAR(10) +" & _
" N'SELECT" & _
" LEFT('+ QUOTENAME(d.name," & _
" pt_copysupp COLLATE latin1_General_CI_AS as supplier_Code," & _
" suname COLLATE latin1_General_CI_AS as supplier_Name," & _
" pt_date as Tran_Date," & _
" pt_trantype COLLATE latin1_General_CI_AS as Tran_Type," & _
" pt_header_ref COLLATE latin1_General_CI_AS as Tran_Ref," & _
" pt_gross as Local_Gross," & _
" pt_currencycode COLLATE latin1_General_CI_AS as Foreign_Currency_Code," & _
" pt_curr_valu As Foreign_Currency_Gross" & _
" FROM ' + QUOTENAME(d.name) + '.dbo.pl_transactions" & _
" inner Join ' + QUOTENAME(d.name) + '.dbo.pl_accounts on ' + QUOTENAME(d.name) + '.dbo.pl_transactions.pt_copysupp = ' + QUOTENAME(d.name) + '.dbo.pl_accounts.sucode" & _
" where pt_trantype in (''INV'',''PAY'')" & _
" and pt_date between ''" & Invoiceto & "'' and ''" & InvoiceFrom & "''" & _
" and suname like ''%" & SCountry & "%'''" & _
" FROM sys.databases d" & _
" WHERE NAME like '%AccountsLive'" & _
" FOR XML PATH(''),TYPE)" & _
" .value('text()[1]','');" & _
" exec(@sql);"
Debug.Print sqlQry
'import table - choose range of where to put the table
Set recset = New ADODB.Recordset
recset.Open sqlQry,Conn
Range("C17").copyFromrecordset recset
recset.Close
Conn.Close
Set recset = nothing
'remove any trailing spaces
For Each c In ActiveSheet.UsedRange
V = c.Value
If V <> "" Then
If Not c.HasFormula Then
c.Value = Trim(V)
End If
End If
Next c
'sort by supplier name
lrow = Range("C" & Rows.Count).End(xlUp).Row
If Not IsEmpty(Sheets("Search").Range("C18").Value) Then
ActiveWorkbook.Worksheets("Search").sort.sortFields.Clear
ActiveWorkbook.Worksheets("Search").sort.sortFields.Add Key:=Range("E17:E" & lrow) _,SortOn:=xlSortOnValues,Order:=xlAscending,DataOption:=xlSortnormal
ActiveWorkbook.Worksheets("Search").sort.sortFields.Add Key:=Range("D17:D" & lrow) _,DataOption:=xlSortnormal
ActiveWorkbook.Worksheets("Search").sort.sortFields.Add Key:=Range("F17:F" & lrow) _,DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Search").sort
.SetRange Range("C16:K" & lrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.sortMethod = xlPinYin
.Apply
End With
End If
'convert CRN to negative
If IsEmpty(Range("C17")) Then
'do nothing
Else
'local gross amount
Range("M17").Formula = "=IF(G17=""CRN"",I17*-1,I17)"
Range("M17").copy Range("M17:M" & lrow)
Range("M17:M" & lrow).copy
Range("I17").PasteSpecial xlPasteValues
'foreign currency gross
Range("M17").Formula = "=IF(G17=""CRN"",K17*-1,K17)"
Range("M17").copy Range("M17:M" & lrow)
Range("M17:M" & lrow).copy
Range("K17").PasteSpecial xlPasteValues
End If
'convert PAY to negative
If IsEmpty(Range("C17")) Then
'do nothing
Else
'local gross amount
Range("M17").Formula = "=IF(G17=""PAY"",I17)"
Range("M17").copy Range("M17:M" & lrow)
Range("M17:M" & lrow).copy
Range("I17").PasteSpecial xlPasteValues
'foreign currency gross
Range("M17").Formula = "=IF(G17=""PAY"",K17)"
Range("M17").copy Range("M17:M" & lrow)
Range("M17:M" & lrow).copy
Range("K17").PasteSpecial xlPasteValues
Columns(13).ClearContents
End If
'add GBP conversion
If IsEmpty(Range("C17")) Then
'do nothing
Else
Range("L17").Formula = "=IF(K17=0,I17/ROUND(PALO.DATAC(""PaloACS/ManAcc"",""FXRates"",""Actual"",'Servers + Databases'!$B$35,'Servers + Databases'!$B$36,J17,""Average Rate"")/PALO.DATAC(""PaloACS/ManAcc"",""GBP"",""Average Rate""),4),K17/ROUND(PALO.DATAC(""PaloACS/ManAcc"",4))"
Range("L17").copy Range("L17:L" & lrow)
End If
'format sheet
'Number Format
Range("I17:I1000000").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
Range("K17:L100000").NumberFormat = "#,##0.00)"
Columns(8).NumberFormat = "0"
'Align
Range("F17:H1000000").HorizontalAlignment = xlLeft
'Autofit
Columns(5).AutoFit
End If
Range("C11").Select
End Sub
因此您可以看到此 VBA 代码中包含相同的 sql 查询……有人知道为什么 VBA 不填充查询吗？ （抱歉 VBA 代码的长度，但我认为最好显示整个内容！）
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
