在循环VBA访问中动态运行字符串

【问题标题】：Dynamically run strings in a loop VBA Access在循环VBA访问中动态运行字符串
【发布时间】：2021-01-31 17:02:22
【问题描述】：

[抱歉，我决定进行编辑以便更好地理解我正在尝试做的事情]

是否可以动态运行字符串，如果可以，如何动态运行？

我要做的是运行一个 VBA 循环来为第一条记录之后的每条记录构建一个 SQL 联合。由于可能有 1 条记录到 100 条记录，我希望它是动态的，因此我不必限制条目的数量。

示例： 如果我有 5 条记录，它会创建带有 4 个联合的 SQL 查询。所有相同的数据等。

我想要做的是这个。 当有人打开表格时，他们将输入包装编号列表，从中他们将选择每个包装编号下的报价范围（所有报价、促销或买家）。然后，当代码运行时，它会根据他们选择的报价范围为每个包号构建一个联合查询。然后，输出会为他们提供该包号下有关这些优惠的所有数据。

这里的参考是我的完整代码： （我为篇幅道歉，但我认为有必要了解全貌）

Private Sub ReviewButton_Click()
Dim Owner As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdfPassThrough As QueryDef
Dim strSeasonSQL As String
Dim strSeason As String
Dim strType As String

Owner = GetNamespace("MAPI").Session.CurrentUser.AddressEntry

        If Me.NewRecord = True Then
            Me!Owner.Value = Owner
        End If
        
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("RetailEntry")
'Set rs = CurrentDb.OpenRecordset("SELECT * FROM RetailEntry")

strSeason = [Forms]![Retail_Navigation]![NavigationSubform].[Form]![cboSeason]
strType = rs.Fields("Offer").Value '[Forms]![ReviewButton]![RetailEntry].[Form]![Offer].Value

On Error GoTo 1
1:

'Build Initial Query based on first record and make sure there are records
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'All Offers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If rs.Fields("Offer") = "All Offers" Then
        StrSQL = "Set NoCount ON DROP TABLE #catcov; " _
            & "SELECT DISTINCT mailyear, offer, description, firstreleasemailed, season_id, offer_type, " _
            & "case when description like '%Promo%' then 'Promo' " _
            & "Else 'Buyer' end As addtype " _
            & "INTO #catcov " _

        strSELECT = "FROM supplychain_misc.dbo.catcov; " _
            & "SELECT DISTINCT " _
            & "a.PackNum " _
            & ",a.Description " _
            & ",a.CatID " _
            & ",DATEPART(QUARTER, FirstReleaseMailed) as Quarter " _
            & ",a.RetOne " _
            & ",a.Ret2 " _
            & ",a.ORIGINALRETAIL " _
            & ",a.DiscountReasonCode " _
            & ",b.Season_id " _
            & ",a.year " _
            & ",addtype "

        strFROM = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _

        strWHERE = "WHERE b.Offer_Type In('catalog', 'insert', 'kicker', 'statement insert', 'bangtail', 'onsert', 'outside ad') " _
            & " and b.Season_id = '" & strSeason & "' " _
            & " and (Case when b.FirstReleaseMailed >= cast(dateadd(day, +21, getdate()) as date) then 1 else 0 end) = 1 "

StrSQL = StrSQL & vbCrLf & strSELECT & vbCrLf & strFROM & vbCrLf & strWHERE

'Promo/Core
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ElseIf rs.Fields("Offer") = "Promo" Or rs.Fields("Offer") = "Buyer" Then
        StrSQL = "Set NoCount ON DROP TABLE #catcov; " _
            & "SELECT DISTINCT mailyear, offer, description, firstreleasemailed, season_id, offer_type, " _
            & "case when description like '%Promo%' then 'Promo' " _
            & "Else 'Buyer' end As addtype " _
            & "INTO #catcov " _
        
        strSELECT = "FROM supplychain_misc.dbo.catcov; " _
            & "SELECT DISTINCT " _
            & "a.PackNum " _
            & ",a.Description " _
            & ",a.CatID " _
            & ",DATEPART(QUARTER, FirstReleaseMailed) as Quarter " _
            & ",a.RetOne " _
            & ",a.Ret2 " _
            & ",a.ORIGINALRETAIL " _
            & ",a.DiscountReasonCode " _
            & ",b.Season_id " _
            & ",a.year " _
            & ",addtype "
      
      strFROM = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _
      
      strWHERE = "WHERE b.Offer_Type In('catalog', 'insert', 'kicker', 'statement insert', 'bangtail', 'onsert', 'outside ad') " _
            & " and b.Season_id = '" & strSeason & "' and b.addtype = '" & strType & "' " _
            & " and (Case when b.FirstReleaseMailed >= cast(dateadd(day, +21, getdate()) as date) then 1 else 0 end) = 1 "

StrSQL = StrSQL & vbCrLf & strSELECT & vbCrLf & strFROM & vbCrLf & strWHERE
End If

'Build/Loop Unions for each record after the first
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rs.MoveNext
strType = rs.Fields("Offer").Value
Do Until rs.EOF = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'All Offers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If rs.Fields("Offer") = "All Offers" Then
        StrUnion = "UNION SELECT DISTINCT " _
            & "a.PackNum " _
            & ",a.Description " _
            & ",a.CatID " _
            & ",DATEPART(QUARTER, FirstReleaseMailed) as Quarter " _
            & ",a.RetOne " _
            & ",a.Ret2 " _
            & ",a.ORIGINALRETAIL " _
            & ",a.DiscountReasonCode " _
            & ",b.Season_id " _
            & ",a.year " _
            & ",addtype "

        strFROMnxt = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _

        strWHEREnxt = "WHERE b.Offer_Type In('catalog', 'insert', 'kicker', 'statement insert', 'bangtail', 'onsert', 'outside ad') " _
            & " and b.Season_id = '" & strSeason & "' " _
            & " and (Case when b.FirstReleaseMailed >= cast(dateadd(day, +21, getdate()) as date) then 1 else 0 end) = 1 "

StrSQL2 = StrUnion & vbCrLf & strFROMnxt & vbCrLf & strWHEREnxt

'Promo/Buyer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ElseIf rs.Fields("Offer") = "Promo" Or rs.Fields("Offer") = "Buyer" Then
        StrUnion = "UNION SELECT DISTINCT " _
            & "a.PackNum " _
            & ",a.Description " _
            & ",a.CatID " _
            & ",DATEPART(QUARTER, FirstReleaseMailed) as Quarter " _
            & ",a.RetOne " _
            & ",a.Ret2 " _
            & ",a.ORIGINALRETAIL " _
            & ",a.DiscountReasonCode " _
            & ",b.Season_id " _
            & ",a.year " _
            & ",addtype "
      
      strFROMnxt = "FROM PIC704Current a JOIN #CatCov b ON (a.CatID = b.Offer) and (a.Year = b.MailYear) " _
      
      strWHEREnxt = "WHERE b.Offer_Type In('catalog', 'insert', 'kicker', 'statement insert', 'bangtail', 'onsert', 'outside ad') " _
            & " and b.Season_id = '" & strSeason & "' and b.addtype = '" & strType & "' " _
            & " and (Case when b.FirstReleaseMailed >= cast(dateadd(day, +21, getdate()) as date) then 1 else 0 end) = 1 "

StrSQL2 = StrUnion & vbCrLf & strFROMnxt & vbCrLf & strWHEREnxt
End If

'Move to next Record and loop till EOF
rs.MoveNext
Loop

'If there are no Records then error
Else
    MsgBox "There are no Pack Numbers Entered."
End If

'END QUERY
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Build Retail Bump File Pass Through Query
    db.QueryDefs.Delete "qryMaster"
    Set qdfPassThrough = db.CreateQueryDef("qryMaster")
    qdfPassThrough.Connect = "ODBC;DSN=SupplyChainMisc;Description=SupplyChainMisc;Trusted_Connection=Yes;DATABASE=SupplyChain_Misc;"
    qdfPassThrough.ReturnsRecords = True
    qdfPassThrough.sql = StrSQL & vbCrLf & StrSQL2

rs.Close
Set rs = Nothing

DoCmd.OpenForm "SubCanButton"
DoCmd.OpenQuery "MasterQuery"

DoCmd.Close acForm, "ReviewButton"

End Sub

【问题讨论】：

  • 您似乎为 SQL Server 构建了传递查询，因此打印出完成的 SQL 并在 SQL Server Management Studio 中运行以进行调试.
  • @Gustav 我这样做是为了进行更正。我能够让它运行一条记录或两条记录。一旦我超过我有问题，这是因为 StrSQL 行StrSQL2 = StrQL & vbCrLf & StrUnion & vbCrLf & strFROMnxt & vbCrLf & strWHEREnxt 这是因为我不知道如何以这样一种方式使这个动态，我可以运行超过 2 条记录，这就是我我试图弄清楚是否有可能。
  • 有可能，但我无法调试你的代码，更不用说未知的输出了。
  • 啊，误解了你最初的意思@Gustav 我已经添加了查询正在构建的表数据，并且我已经添加了 SQL 查询数据输出。希望这有帮助吗？如果您有任何想法或需要其他任何东西，请告诉我。
  • 数据应该以文本表格的形式提供，而不是图像。也显示所需的输出。 AFAIK，UNION 的 SELECT 行限制为 50 行。

标签： sql vba ms-access


【解决方案1】：

首先，当您不包含 ALL 时，您会执行“union distinct”：

UNION ALL
SELECT DISTINCT ...

因此，由于您选择的记录看起来相同，因此只会返回一个。

第二，包括ALL与否，你的概念没有多大意义。为什么要合并很多相同的记录？即使它们只拥有不同的 ID，它们似乎也是从同一个表中提取的，您可以通过单个查询来实现。

第三，将日期值转换为日期值没有任何好处，所以：

cast(dateadd(day, +21, getdate()) as date)

可以简化为：

dateadd(day, +21, getdate())

【讨论】：

  • 抱歉，我认为我没有很好地解释我想要做的事情。这更像是 VBA 而不是 SQL 中的编程问题。我重新输入了我原来的问题。我希望能够根据表中的记录集动态运行字符串。联合将是动态构建的部分，但具体的 SQL 代码没有任何问题。
  • 如果您已经构建了一个包含完整查询的字符串，您可以使用CurrentDb.OpenRecordset(StrSQL) 打开一个记录集。
  • 更正我附加的代码显示了我目前正在尝试如何做到这一点。问题是我仅限于运行 StrSQL2 一次的次数。我试图让它为记录集中的每个包号运行它，所以如果我有 5 个包号，它会运行StrSQL & StrSQL2 & StrSQL2 & StrSQL2 & StrSQL2 或者除了第一个包号之外还有很多包号。
  • 然后运行一个循环，并为每个包号添加一个查询到 SQL。但有件事告诉我，这是一种过于复杂的方法，可能需要重新考虑。
  • 有可能。我在编程 SQL 和 VBA 方面是自学的，但我不知道任何其他方式来做我想做的事情。可能有另一种更有效的方法，我已经研究了几天这个特殊问题，到目前为止还没有什么突出的。这就是我来这里寻求帮助的原因。看起来我可能运气不好，需要努力做到这一点。
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 2020-12-02
  • 2014-09-19
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2011-07-24
相关资源
最近更新 更多
热门标签
Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode