程序问答   发布时间:2022-06-01  发布网站:大佬教程  code.js-code.com
大佬教程收集整理的这篇文章主要介绍了在 VBA 中运行时,SQL 查询未显示所有结果大佬教程大佬觉得挺不错的,现在分享给大家,也给大家做个参考。

如何解决在 VBA 中运行时,SQL 查询未显示所有结果?

开发过程中遇到在 VBA 中运行时,SQL 查询未显示所有结果的问题如何解决?下面主要结合日常开发的经验,给出你关于在 VBA 中运行时,SQL 查询未显示所有结果的解决方法建议,希望对你解决在 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 (将#修改为@)

大佬总结

以上是大佬教程为你收集整理的在 VBA 中运行时,SQL 查询未显示所有结果全部内容,希望文章能够帮你解决在 VBA 中运行时,SQL 查询未显示所有结果所遇到的程序开发问题。

如果觉得大佬教程网站内容还不错,欢迎将大佬教程推荐给程序员好友。

本图文内容来源于网友网络收集整理提供,作为学习参考使用,版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ:384754419,请注明来意。
标签: